Visual Basic-Code in Excel

Question

Das ist mein Tisch ist:

Ich mag aus rohen Tabellendaten suchen und dann die Daten füttern nach Datum und Marke in ausgewählten m1, m2, m3, die Ausgabe, Verschwendung, extra, Felder packen. Das Problem hier ist, dass meine Tabelle nicht nach meinen Bedürfnissen apdating ist. Hier aktualisiert mein Code keine Daten für die Marke "b" des ausgewählten Datums.

Dies ist mein Code:

Sub FindMatches() 
    Dim oldrow As Integer 
    Dim newrow As Integer 
    For oldrow = 4 To 14 
     For newrow = 3 To 20 
      If Cells(oldrow, 12) = Cells(1, newrow) And Cells(oldrow, 13) = Cells(newrow, 1) Then 'date and brand 
        If Cells(1, 14) = Cells(newrow, 2) Then 
          Cells(newrow, 3).Value = Cells(oldrow, 14).Value ' m1 
        End If 
        If Cells(1, 15) = Cells(newrow + 1, 2) Then 
          Cells(newrow + 1, 3).Value = Cells(oldrow, 15).Value ' m2 
        End If 
        If Cells(1, 16) = Cells(newrow + 2, 2) Then 
            Cells(newrow + 2, 3).Value = Cells(oldrow, 16).Value ' m3 
        End If 
        If Cells(1, 17) = Cells(newrow + 3, 2) Then 
             Cells(newrow + 3, 3).Value = Cells(oldrow, 17).Value ' issue 
        End If 
        If Cells(1, 18) = Cells(newrow + 4, 2) Then 
              Cells(newrow + 4, 3).Value = Cells(oldrow, 18).Value ' repack 
        End If 
        If Cells(1, 19) = Cells(newrow + 5, 2) Then 
               Cells(newrow + 5, 3).Value = Cells(oldrow, 19).Value ' extra 
        End If 
        If Cells(1, 20) = Cells(newrow + 6, 2) Then 
        Cells(newrow + 6, 3).Value = Cells(oldrow, 20).Value ' wastage 
        End If 
     End If 

     Next newrow 
     Next oldrow 
End Sub 

Answer 1

ich mit dem folgenden

Option Explicit 
Sub FindMatches() 

Dim rawRng As Range, newTableDateRng As Range, newTableBrandRng As Range, cell As Range, foundDate As Range, foundBrand As Range 

Set rawRng = Worksheets("shet").Range("L3:T100") 
Set newTableDateRng = Worksheets("shet").Range("C2:I2") 
Set newTableBrandRng = Worksheets("shet").Range("A4:A100") 

With rawRng  

    For Each cell In .Columns(1).SpecialCells(xlCellTypeConstants) 
     Set foundDate = newTableDateRng.Find(What:=cell, LookIn:=xlValues, LookAt:=xlWhole) 
     If Not foundDate Is Nothing Then 
      Set foundBrand = FindValue(newTableBrandRng, cell.Offset(, 1)) 
      If Not foundBrand Is Nothing Then 
       cell.Offset(, 2).Resize(, 7).Copy 
       Intersect(foundDate.EntireColumn, foundBrand.EntireRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True 
      End If 
     End If 
    Next cell 

End With 

End Sub 


Function FindValue(rng As Range, value As String) As Range 

On Error Resume Next 
Set FindValue = rng.Cells(Application.WorksheetFunction.Match(value, rng, 0)) 
On Error GoTo 0 

End Function 

gehen würde, bitte beachten Sie, dass alle Grundeinstellungen sind spezifisch für Daten „Struktur“, wie pro Ihr Screenshot Beispiel. Wenn Sie es ändern müssen, müssen Sie dem gleichen "Muster" folgen (d. h. rawRng beginnt mit der ersten Datenzeile "Rohtabelle" unter der Überschrift und so weiter). auch beachten, dass die 7 Zahl in cell.Offset(, 2).Resize(, 7).Copy Anweisung verwendet wird, stammt aus der Datenstruktur geschrieben, wo Sie brauchen, kopieren Werte von „m1“ bis „Verschwendung“ Felder enthalten ist, und dass Sie müssen dann sicherstellen, dass jede „Marke“ Reihen-Gruppe in „neue Tabelle“ muss dieses Muster entspricht (nämlich haben 7 Zeilen)