Question

我对VBA比较陌生，我只有一些使用Python的经验，只有很少的经验来查看其他VBA宏并根据我的需要进行调整，所以我正在尽我所能。

我要做的是对于工作表B中粘贴的每个部件号（工作表B，行A）我想从包含所有部件号（工作表D，行A）和副本的不同工作表中找到相同的部件号从工作表D到另一列（工作表B，行D）的描述（工作表D，行H）然后检查行中的下一个部件号并重复。

我得到的当前错误是“编译错误：没有，否则”，我很抱歉我不是很精通，但任何帮助将不胜感激。

其他信息：

- 我可以在工作表A中填写要在工作表B，B列中搜索的部件号，是否可以将其设为A！B2或= CONCATENATE（A！B2）？

Sub Description()

Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
Dim Rng As Range
Set wsB = Worksheets("B")
Set wsD = Worksheets("D")

Do: aRow = 2
        If wsB.Cells(aRow, 2) <> "" Then
     With Worksheets("D").Range("A:A")
        x = wsB.Cells(aRow, 2)
        Set Rng = .Find(What:=x, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        Selection.Copy
        wsB.Cells(dRow, 2).Paste
     dRow = dRow + 1
    Else
        aRow = aRow + 1

Loop Until wsB.Cells(aRow, 2) = ""
End Sub

再次感谢！

编辑：无法在中断模式下执行代码是当前错误

Sub Description()
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
Dim Rng As Range
Set wsB = Worksheets("B")
Set wsD = Worksheets("D")
aRow = 2
dRow = 2

    Do:
        If wsB.Cells(aRow, 1) <> "" Then
            With Worksheets("D").Range("A:A")
                Set Rng = .Find(What:=wsB.Cells(aRow, 1), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                Rng.Copy
                Rng.Offset(0, 3).Paste (Cells(aRow, 4))
                dRow = dRow + 1
                aRow = aRow + 1
            End With
        End If
    Loop Until wsB.Cells(aRow, 1) = ""
End Sub

Answer 1

您可以尝试将End If放在aRow = aRow + 1之后的下一行。有关语法msdn.microsoft.com/en-us/library/752y8abs.aspx，请参阅MSDN

Answer 2

在Excel中，我们通常将垂直范围称为列，将水平范围称为行。从您的代码和问题描述中，我假设您所说的“行A”是A列。此外，您的代码扫描wsB.Cells（aRow，2）。它是B栏而不是A栏。无论如何，这只是一个小问题。

以下代码将检查工作表B的B列的单元格。如果找到相同的值在工作表D的A列中，然后工作表D的H列中的相应单元格将会出现被复制到工作表B的B列中的单元格。

Option Explicit
Sub Description()
   Dim wsB As Worksheet, wsD As Worksheet, aRow As Long
   Dim rngSearchRange As Range, rngFound As Range
   Set wsB = Worksheets("B")
   Set wsD = Worksheets("D")
   Set rngSearchRange = wsD.Range("A:A")
   aRow = 2
   Do While wsB.Cells(aRow, 2).Value <> ""
      Set rngFound = rngSearchRange.Find(What:=wsB.Cells(aRow, 2).Value, LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
         wsD.Cells(rngFound.Row, 8).Copy Destination:=wsB.Cells(aRow, 4)  ' Indexes of Column H, D are respectively 8, 4
      End If
      aRow = aRow + 1
   Loop
End Sub

Answer 3

这对我有用。

Sub Description()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("B").Range("B2:B" & LastRow)
        Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H")
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

选择和粘贴细胞

3 个答案: