如果满足条件,则复制选定的单元格

时间:2020-04-20 03:05:38

标签: excel vba

我在Sheet3中有一个名称列表, 列A:6-33中包含一些客户端的名称 B栏:6-33空 C栏:6-33为空

我也有Sheet4: 列A 5000个客户名称 C和F列具有该客户的重要数据,我需要将其复制到Sheet3中的B和C列。

所以当Sheet3.Cell Ax == Sheet4.Cell Ax Sheet3.BC需要复制Sheet4.CF

的数据

以某种方式我无法正确执行循环。 现在我有隧道视野,但似乎无法解决此问题。

2 个答案:

答案 0 :(得分:1)

一种可能的解决方案是VLOOKUP函数:

第3张纸

  • B列公式(将公式导入单元格B6中并向下拖动):

=VLOOKUP(A6,Sheet4!$A$1:$F$5000,3,0)

  • C列公式(将公式导入单元格C6中并向下拖动):

=VLOOKUP(A6,Sheet4!$A$1:$F$5000,6,0)

VBA代码:

Option Explicit

Sub tes()

     Dim ws3 As Worksheet, ws4 As Worksheet
     Dim i As Long
     Dim rngSearch As Range, rngFound As Range
     Dim arr As Variant
     Dim strValueC As String, strValueF As String

     With ThisWorkbook
        Set ws3 = .Worksheets("Sheet3")
        Set ws4 = .Worksheets("Sheet4")
     End With

     With ws3
        arr = .Range("A6:A33")
        .Range("B6:C33").Clear
     End With

     Set rngSearch = ws4.Range("A1:A5000")

     For i = LBound(arr) To UBound(arr)

        Set rngFound = rngSearch.Find(What:=arr(i, 1), LookIn:=xlValues, LookAt:=xlWhole)

        If Not rngFound Is Nothing Then

            With ws4
                strValueC = .Range("C" & rngFound.Row).Value
                strValueF = .Range("F" & rngFound.Row).Value
            End With

            With ws3
                .Range("B" & i + 5).Value = strValueC
                .Range("C" & i + 5).Value = strValueF
            End With

        End If

     Next i

End Sub

答案 1 :(得分:1)

Dim clientrange As Range
Dim searchrange As Range
Dim i As Long

Set clientrange = ActiveWorkbook.Sheets(3).Range("A6") 'you may have to use sheets("sheet3")
With ActiveWorkbook.Sheets(4) 'you may have to use sheets("sheet4")
    While clientrange.Text <> ""
        'search for clients in sheet4
        For i = 1 To 5000
            If .Range("A" & i) = clientrange.Text Then
                'copy the values
                clientrange.Offset(0, 1) = .Range("C" & i)
                clientrange.Offset(0, 2) = .Range("F" & i)
                Exit For
            End If
        Next i
        'go one down
        Set clientrange = clientrange.Offset(1, 0)
    Wend
End With