Question

我在这方面很陌生，而且我已经完成了大量的教程，但我似乎无法掌握如何在excel VBA中实现这一结果的概念。我会尝试尽可能详细。

我有一个包含3个Excel文件的文件夹 -

Script.xlsx （只是一个包含脚本/宏的按钮）
WhiteCrown.xlsx （工作簿我想复制数据）
PackCon.xlsx （工作簿我喜欢粘贴的数据）

概念：如果工作簿（＆＃34; WhiteCrown.xlsx＆＃34;）包含B5列中的值：B10000 =工作簿（＆＃34; PackCon.xlsx＆＃34;）B5列：B10000和工作簿（＆＃34; WhiteCrown.xlsx＆＃34;）包含E列中的值

有2个细胞我不想要复制E的价值 - ＆＃34;豆浆＆＃34; ＆＃34;百事可乐-MAX＆＃34;

检查将循环到b列达到10000

:)提前感谢

Sub ConvertData()

Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v

Application.ScreenUpdating = False

Set wb1 = Workbooks.Open("C:\Users\amir.abdul\Desktop\Completed\New folder\WhiteCrown.xlsx")
Set ws1 = wb1.Sheets("BOMQ")

Set wb2 = Workbooks.Open("C:\Users\amir.abdul\Desktop\Completed\New folder\PackCon.xlsx")
With wb2.Sheets("("BOMQ")")
    Set rngLookup = .Range(.Cells(7, 2), _
                    .Cells(7, 2).End(xlDown)).Resize(, 3)
End With

With ws1
    i = 7
    Do Until .Cells(i, 2) = ""
        v = Application.VLookup(.Cells(i, 2).Value, rngLookup, 3, False)
        If Not IsError(v) Then .Cells(i, 4).Value = v
        i = i + 1
    Loop
End With

wb2.Close False


End Sub

*脚本已更新但仍无法正常工作

Answer 1

我不了解您要复制的数据。我已经展示了这样做的逻辑。经过测试和工作。

Option Explicit

Private Sub btnScript_Click()

Dim WhiteCrown As Workbook, PackCon As Workbook, DestWorkbook As Workbook
Dim SheetWhiteCrown As Worksheet, SheetPack As Worksheet
Dim RowIndex As Long
Dim RngWhite As Range
Dim RngWhiteCount As Long
Dim ValBWhite, ValBPack, ValEWhite As String

Application.ScreenUpdating = False

Set WhiteCrown = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\WhiteCrown.xlsx")
Set SheetWhiteCrown = WhiteCrown.Sheets("BOMQ")
Set RngWhite = SheetWhiteCrown.Range("RngWhiteData")

RngWhiteCount = SheetWhiteCrown.Range("RngWhiteData").Rows.Count + 5


Set PackCon = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\PackCon.xlsx")
Set SheetPack = PackCon.Sheets("BOMQ")

Set DestWorkbook = Workbooks.Open("C:\Users\Mani\Desktop\Stackoverflow\Script.xlsx")

For RowIndex = 5 To RngWhiteCount
     ValBWhite = SheetWhiteCrown.Cells(RowIndex, "B").Value
     ValBPack = SheetPack.Cells(RowIndex, "B").Value
     ValEWhite = SheetWhiteCrown.Cells(RowIndex, "E").Value

    If Not ValBWhite = "" And ValBWhite = "" Then

         If Not ((ValEWhite = "SoyMilk") Or (ValEWhite = "Pepsi")) Then

           'Perform your copy to Destworkbook or vlookup or anything               
         Else
             'Do Nothing
         End If

    End If

Next RowIndex
WhiteCrown.Close
PackCon.Close
DestWorkbook.Close False

End Sub

切勿使用范围内的硬编码范围（＆＃34; B10：E60＆＃34;）。最佳编码实践涉及使用命名范围，如上面的代码（示例＆＃34; RngWhiteData＆＃34;命名范围）。添加错误验证。

如果您满意，请投票给我答案。

此致

摩尼

Excel VBA - 根据条件将单元格复制到另一个保存在同一文件夹中的工作簿

1 个答案: