根据条件复制内容

qiurongzhuang88

请大师帮我解决，根据条件复制内容

qiurongzhuang88

本人非常感谢这个论坛，感谢帮助我的大师。

NadrsSaber

1. Sub tjCopy()
   
2.     Dim arr, rng As Range
   
3.     With Sheet1
   
4.         arr = Split(.[G1], ",")
   
5.         For i = 0 To UBound(arr)
   
6.             Set rng = .Range("A:A").Find(arr(i))
   
7.             If Not rng Is Nothing Then
   
8.                 .Range("I1:L1").Copy .Range("B" & rng.Row)
   
9.                 Set rng = Nothing
   
10.             End If
    
11.         Next
    
12.     End With
    
13. End Sub

复制代码

cfzzj

1. Public Sub 按要求复制()
   
2.     Dim CXrng As Range
   
3.     For Each CXrng In Range("a2:a" & Range("a65536").End(xlUp).Row)
   
4.         If "," & Range("G1").Value & "," Like "*," & CXrng.Value & ",*" Then
   
5.             CXrng.Offset(0, 1).Resize(1, 4) = Range("I1:L1").Value
   
6.         End If
   
7.     Next
   
8. End Sub

复制代码

qiurongzhuang88

编号相同怎样修改语言

NadrsSaber

1. <p>Sub tjCopy()
   
2.     Dim arr, rng As Range
   
3.     With Sheet1
   
4.         arr = Split(.[G1], ",")
   
5.         For i = 0 To UBound(arr)
   
6.             Set rng = .Range("A:A").Find(arr(i))
   
7.             If Not rng Is Nothing Then</p><p>                if rng.offset(0,1) = "" then'加这句
   
8.                 .Range("I1:L1").Copy .Range("B" & rng.Row)
   
9.                 Set rng = Nothing</p><p>                end if
   
10.             End If'加这句'
    
11.         Next
    
12.     End With
    
13. End Sub</p>

复制代码

NadrsSaber

qiurongzhuang88 发表于 2019-12-20 12:15
编号相同怎样修改语言

If Not rng Is Nothing Then
if rng.offset(0,1) = "" then
.Range("I1:L1").Copy .Range("B" & rng.Row)
Set rng = Nothing
End If
end if