Wie hookup von einem Arbeitsblatt zu einem anderen und wiederhole für mehrere Zeilen

Question

Ich habe ein Arbeitsblatt (Blatt 1) ​​mit 272 Bezirken (Spalte D4: D275) und jede Zeile hat 11 Kategorien (Kategorienamen E3: O3) (Siehe Bild 1):

http://i.stack.imgur.com/mFnaf.png

ich diese Daten (in Blatt 2) neu anordnen muß, so daß jede Kategorie seine eigene Reihe hat (dh 272 * 11 Zeilen insgesamt). (Siehe Bild 2):

http://i.stack.imgur.com/wvfXS.png

Ich weiß, das erfordert HLOOKUP aber ich weiß nicht, wie der VBA-Code für sie zu schreiben. Bitte sagen Sie mir, was der Code ist, den ich benötige, und erkläre, was jeder Schritt tut, da ich dies auf einer Reihe von verschiedenen Dokumenten tun muss, also muss ich wissen, wie man den Code einstellt.

Lassen Sie mich wissen, wenn mehr Informationen

Vielen Dank benötigt wird!

Answer 1

Wenn Sie die Formel wissen Sie sollen auf dem Bildschirm zu verwenden, kann die gleiche forumla durch Makro-VBA-Code von Application.WorksheetFunction mit

kann

=VLOOKUP(XXXX) 

als

Application.WorksheetFunction.VLookup(XXXX) 

in Makro geschrieben werden verwendet werden,

Hoffe das hilft.

Answer 2

basierend auf den Screenshots beigefügt, wird dies die Arbeit tun, welche die Werte jeweils in den Spalten A, B und C

Count = 4 

For i = 4 To 18 
    For j = 5 To 15 
     Cells(Count, 1).Value = Cells(i, 4).Value 
     Cells(Count, 2).Value = Cells(i, j).Value 
     Cells(Count, 3).Value = Cells(3, j).Value 
     Count = Count + 1 
    Next j 
Next i 

Answer 3

Versuchen mit unten hinzufügen. Mit freundlicher

ändern

Sub test() 
    Dim r As Range 
    Dim incre As Long 
    Dim distr As String 
    Set r = Range("D4:K6") 
    incre = 4 
    incre2 = 4 
    For Each cell In r 
     If cell Like "District*" Then 
      distr = cell.Value 
     Else 
      Range("B" & incre).Value = cell.Value 
      Range("A" & incre).Value = distr 
      incre = incre + 1 
     End If 
    Next 
End Sub 

Answer 4

Nun, es gibt mehrere Wege, um zu erreichen, was Sie erreichen wollen.

1. Verwenden Formel

In Zell A4 von Sheet2 geben Sie die folgende Formel und Ziehen/Kopieren nach unten nach Bedarf

=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0) 

In Zell C4 von Sheet2 geben Sie die folgende Formel und ziehen/nach Bedarf kopieren

=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11)) 

2.VBA

Methode I - berechnen Werte von Sheet1 und aktualisieren Sie den Bereich in Sheet2

Sub Demo1() 
    Dim srcWB As Workbook 
    Dim srcWS As Worksheet, destWS As Worksheet 
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp 

    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    Set srcWB = ThisWorkbook 
    Set srcWS = srcWB.Sheets("Sheet1") 
    Set destWS = srcWB.Sheets("Sheet2") 
    CategoryCnt = 11 '->enter number of categories 
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row '->last row with data 
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column '->last column with data 

    For i = 4 To (lastRow - 4) * CategoryCnt 
     destWS.Cells(i, 1) = srcWS.Cells(Int((i - 4)/CategoryCnt) + 4, 4) 
     destWS.Cells(i, 3) = srcWS.Cells(Int((i - 4)/CategoryCnt) + 4, ((i - 4) Mod CategoryCnt) + 5) 
    Next i 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

Methode II - Geben Sie Formel in Sheet2 Bereich

Sub Demo2() 
    Dim srcWB As Workbook 
    Dim srcWS As Worksheet, destWS As Worksheet 
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp 

    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    Set srcWB = ThisWorkbook 
    Set srcWS = srcWB.Sheets("Sheet1") 
    Set destWS = srcWB.Sheets("Sheet2") 
    CategoryCnt = 11 
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row 
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column 

    destWS.Range("A4").Formula = "=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0)" 
    destWS.Range("C4") = "=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11))" 
    Range("A4:C4").Select 
    Selection.AutoFill Destination:=destWS.Range("A4:C" & (lastRow - 4) * 11), Type:=xlFillDefault 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

Lassen Sie mich wissen, wenn etwas nicht klar ist.

Siehe Bild als Referenz:

Sheet1

Sheet2