Jak utworzyć wiele wierszy łączących zestawy danych

Mam trzy tabele i potrzebuję wyjścia, które zawiera dane z dwóch tabel, chciałbym utworzyć to samo za pomocą makra.

Tabela A

A
B
C
D

Tabela B

Apple
Orange
Pears

Tabela C

Americas
Asia
Europe

Potrzebne dane wyjściowe to

A Apple Americas
A Apple Asia
A Apple Europe
A Orange Americas
A Orange Asia
A Orange Europe

Myślę, że dla każdej litery z tabeli A utworzonych zostanie 12 dodatkowych wierszy. Powyżej są przykładowe dane i mam około 5000 wierszy w tabeli A.

microsoft-excel vba macros

— użytkownik3197779
źródło

Cześć Raystafarian, generalnie używam MS Access i tworzę trzy różne tabele, a następnie tworzę zapytanie, które zapewniłoby wymagane wyniki. Jednak nie mamy już dostępu do MS Access. Dlatego staram się znaleźć wyjście.

— user3197779

Mam inne pytanie, w przypadku gdy w tabeli C mam dane, jak wspomniano poniżej, z dwiema kolumnami Tabela C Ameryka USD Azja JPY Europa EUR I Wyjście byłoby coś takiego: A Apple Ameryka USD A Apple Azja JYP A Apple Europa EUR A Pomarańczowy Ameryka USD Pomarańczowy Azja JPY Pomarańczowy Europa EUR Porady w tej sprawie. Przepraszam, chyba powinienem był to wskazać w pierwszej instancji.

— user3197779

po prostu przesunąć lokalizację zapisu i lokalizację odczytu. Więc możesz zrobić cells(i,3) = e.valueORAZcells(i,4) = e.offset(0,1).value

— Raystafarian

Cześć Ray, Znowu z problemem, tym razem zapytanie działa, ale tworzy tylko do 32 727 wierszy, ale spodziewam się, że moje dane będą miały około 150 000 wierszy. Błąd, który otrzymuję, to błąd czasu wykonania 6 Na podstawie niektórych badań przeprowadziłem „Dim i As Long” i uruchomiłem zapytanie, ale nie pomogłem.

— user3197779,

Jakiej wersji programu Excel używasz? A która linia zostanie podświetlona w wyniku przepełnienia?

— Raystafarian

To zrobi, po prostu odpowiednio zmodyfikuj

Sub Umesh()
Application.ScreenUpdating = False
Dim i As Integer
Dim c As Range
Dim d As Range
Dim e As Range

i = 1

For Each c In Worksheets("Sheet1").Range("A:A")
If c <> "" Then

    For Each d In Worksheets("Sheet2").Range("A:A")
    If d <> "" Then

        For Each e In Worksheets("sheet3").Range("A:A")
            If e <> "" Then

            Worksheets("sheet4").Cells(i, 1) = c.Value
            Worksheets("sheet4").Cells(i, 2) = d.Value
            Worksheets("Sheet4").Cells(i, 3) = e.Value
            i = i + 1

            End If
        Next e

    End If
    Next d

End If
Next c

Application.ScreenUpdating = True
End Sub

— Raystafarian
źródło

Dziękuję Raystafarian. Kod działa dobrze. Bardzo pomocny.

— user3197779,