在Excel中的Visual Basic代码

这是我的桌子：

我想从原始表中search数据，然后根据date和品牌在选定的m1，m2，m3，问题，浪费，额外，重新包装的字段中input数据。 这里的问题是，我的桌子没有根据我的需要进行调整。 这里我的代码没有更新所选date的品牌“b”的数据。

这是我的代码：

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

我会去以下

 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 

请注意，根据您的屏幕截图示例，所有初始设置都是特定于数据“结构”的。 如果需要更改它，则必须遵循相同的“模式”（即rawRng从头下的第一个“原始表”数据行开始，依此类推）。 还要注意在你的发布数据结构中， cell.Offset(, 2).Resize(, 7).Copy语句中使用的7号码需要将值从“m1”复制到“wastage”字段，那么您必须确保“新表”中的每个“品牌”行组必须匹配此模式（即，具有7行）