VBA循环/逻辑问题

我正在写Excel的工作macros，我有麻烦。 在这种情况下，有两张表，“BU”和“TOPS信息”。 当使用macros时，应该在“BU”的每一行search“TOPS Information”中find的值，然后进入“TOPS Information”的下一行并重复该过程，如果find了正确的匹配，复制一个单元格并将其粘贴到“TOPS信息”中。

这里是代码：

Sub QIM() Dim j As Integer Dim k As Integer Dim i As Integer Dim l As Integer Dim m As Integer Dim searchArray(1 To 3) As String j = 0 k = 1 'WARNING: Temporary Sheet Names lastRowTOPS = Worksheets("TOPS Information").Cells(Rows.Count, "A").End(xlUp).Row lastRowBU = Worksheets("BU").Cells(Rows.Count, "A").End(xlUp).Row 'Cycle through BU rows For j = lastRowTOPS To 1 Step -1 'Cycle through searchArray for each BU row For k = lastRowBU To 1 Step -1 '////////////////////////////////////// x = Sheets("BU").Range("B" & k).Value y = Range("C" & j).Value If StrComp(x, y) = 1 Then Sheets("BU").Range("C" & k).Copy Range("H" & j).PasteSpecial End If '////////////////////////////////////// Next k Next j End Sub 

这个macros显然只有当“TOPS信息”被选中的时候才起作用。 任何和所有的帮助将不胜感激。 谢谢！

Answer 1

你自己回答。 范围是指目前的表格，但是当你在弹跳时，你必须有资格。

前面你的范围与适当的工作表像这样，

 Sub QIM() Dim j As Integer Dim k As Integer Dim i As Integer Dim l As Integer Dim m As Integer Dim searchArray(1 To 3) As String j = 0 k = 1 'WARNING: Temporary Sheet Names lastRowTOPS = Worksheets("TOPS Information").Cells(Rows.Count, "A").End(xlUp).Row lastRowBU = Worksheets("BU").Cells(Rows.Count, "A").End(xlUp).Row 'Cycle through BU rows For j = lastRowTOPS To 1 Step -1 'Cycle through searchArray for each BU row For k = lastRowBU To 1 Step -1 '////////////////////////////////////// x = Sheets("BU").Range("B" & k).Value y = Sheets("TOPS Information").Range("C" & j).Value If StrComp(x, y) = 1 Then Sheets("BU").Range("C" & k).Copy Sheets("TOPS Information").Range("H" & j).PasteSpecial End If '////////////////////////////////////// Next k Next j End Sub 

Answer 2

假设只想复制BU顶端最多的数据到TOPS ，可以在下面使用。

 Sub QIM() Dim oWS_TOPS As Worksheet, oWS_BU As Worksheet ' Worksheet objects Dim oRng_TOPS As Range, oRng_BU As Range ' Range objects Dim R_TOPS As Long, R_BU As Long Set oWS_TOPS = ThisWorkbook.Worksheets("TOPS Information") ' <-- Replace this "TOPS Information" to match future changes Set oWS_BU = ThisWorkbook.Worksheets("BU") ' <-- Replace this "BU" to match future changes R_TOPS = oWS_TOPS.Cells(Rows.Count, "A").End(xlUp).Row R_BU = oWS_BU.Cells(Rows.Count, "A").End(xlUp).Row ' Search column B of BU for each cell in column C of TOPS For Each oRng_TOPS In oWS_TOPS.Columns("C").Cells ' <-- Replace this "C" to match future changes ' Exit if row is more than last A column data If oRng_TOPS.Row > R_TOPS Then Exit For For Each oRng_BU In oWS_BU.Columns("B").Cells ' <-- Replace this "B" to match future changes ' Exit if row is more than last A column data If oRng_BU.Row > R_BU Then Exit For ' Check if Ranges match (## See Update ##) If InStr(1, oRng_TOPS.Value, oRng_BU.Value, vbTextCompare) > 0 Then ' Copy column C of found row in BU to column H of TOPS, then exit oWS_BU.Cells(oRng_BU.Row, "C").Copy oWS_TOPS.Cells(oRng_TOPS.Row, "H") ' <-- Replace these "C" and "H" to match future changes Exit For End If Next Next Set oWS_TOPS = Nothing Set oWS_BU = Nothing End Sub 

有很多方法来实现你的目标，这是其中之一。

---

更新注意比较单元格值（string）：

StrComp(S1,S2[,mode])只返回3个值{-1,0,1}来表示S1是否小于/等于/大于S2。 如果你想精确匹配（区分大小写和精确的间距），使用If StrComp(S1,S2) = 0 Then 。

InStr([i,]S1,S2[,mode])只返回正值 – 它返回S1中S2的首次出现的字符位置。 如果没有findS2，则返回零。

您也可以使用Trim(sText)来删除Trim(sText)前导/结束空格。

希望下面的截图说更多。