选择和粘贴单元格

我对VBA相对比较陌生，我只有一些Python的使用经验，只有很少的经验来看待其他VBA宏，并根据我的需要调整它们，所以我正在尝试尽我所能。选择和粘贴单元格

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

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

其他信息：

-My零件号通过工作表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

来源

2015-01-15 Ryan

你可以尝试把End If下一行aRow = aRow + 1后。请参阅MSDN的语法msdn.microsoft.com/en-us/library/752y8abs.aspx

来源

2015-01-15 00:33:32 zmechanic

我相信'Else'之前的'End With'也是必需的。实际上，更好的方法是将'With ... End With'块移到'For ... Next'循环之外，因为它不会被for ... next中的任何东西重新定义。 – Jeeped

是的。在VBA多行语句中需要'End ***' – zmechanic

我把aRow和dRow定义放在Do之上：所以它不会在每次循环时重置 – Ryan

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

下面的代码将检查工作表B的B列的单元如果相同的值被发现在工作表d的列A，然后在工作表的d H列的cooresponding单元将被复制到在列中的单元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

来源

2015-01-15 05:03:50

谢谢！这对我来说非常接近，一个问题是它没有找到这些项目，但只是粘贴它们，所以如果我有12个项目将其粘贴到工作表D的前12个。 – Ryan

是否以某种方式检查工作表B而不是D ，以便它每次匹配并从工作表D粘贴？ – Ryan

这是什么为我工作。

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

来源

2015-01-15 19:29:10 Ryan

选择和粘贴单元格

回答

相关问题