能不能将数据只筛选出黑色字体的E列填到Sheet1的K列

603001932

Private Sub CommandButton1_Click()
Dim N%, K%, I%
With Sheets("Sheet1")
   .UsedRange.Offset(2).Delete
   For I = 3 To [N65536].End(3).Row
      If Range("C" & I) <> nw Then
         N = N + 1: K = 13
         .Range("1:2").Copy .Range("A" & N * 2 + 1)
         .Range("A" & N * 2 + 2) = Range("A" & I)
         .Range("B" & N * 2 + 2) = Range("B" & I)
         .Range("C" & N * 2 + 2) = Range("C" & I)
         .Range("D" & N * 2 + 2) = Range("D" & I)
         .Range("E" & N * 2 + 2) = Range("G" & I)
         .Range("F" & N * 2 + 2) = Range("H" & I)
         .Range("G" & N * 2 + 2) = Range("I" & I)
         .Range("H" & N * 2 + 2) = Range("J" & I)
         nw = Range("C" & I)
      End If
   If Trim(Range("E" & I)) <> "" Then .Range("K" & N * 2 + 2) = .Range("K" & N * 2 + 2) & "," & Range("E" & I)
      K = K + 1
   Next
   .Activate
End With
End Sub
能不能将数据只筛选出黑色字体的E列填到Sheet1的K列

蓝桥玄霜

1. Private Sub CommandButton1_Click()
   
2. Dim N%, K%, I%
   
3. With Sheets("Sheet1")
   
4.    .UsedRange.Offset(2).Delete
   
5.    For I = 3 To [N65536].End(3).Row
   
6.       If Range("C" & I) <> nw Then
   
7.       If Range("E" & I).Font.ColorIndex = 1 Then
   
8.          N = N + 1: K = 13
   
9.          .Range("1:2").Copy .Range("A" & N * 2 + 1)
   
10.          .Range("A" & N * 2 + 2) = Range("A" & I)
    
11.          .Range("B" & N * 2 + 2) = Range("B" & I)
    
12.          .Range("C" & N * 2 + 2) = Range("C" & I)
    
13.          .Range("D" & N * 2 + 2) = Range("D" & I)
    
14.          .Range("E" & N * 2 + 2) = Range("G" & I)
    
15.          .Range("F" & N * 2 + 2) = Range("H" & I)
    
16.          .Range("G" & N * 2 + 2) = Range("I" & I)
    
17.          .Range("H" & N * 2 + 2) = Range("J" & I)
    
18.          nw = Range("C" & I)
    
19.         If Trim(Range("E" & I)) <> "" Then .Range("K" & N * 2 + 2) = .Range("K" & N * 2 + 2) & "," & Range("E" & I)
    
20.       K = K + 1
    
21.       End If
    
22.       End If
    
23.    Next
    
24.    .Activate
    
25. End With
    
26. End Sub
    
27. 
    

复制代码