[已解决]改一下代码，谢谢

fangniuji

帮忙改一下这代码，如果把数据源Ａ到Ｃ列改放AX到AZ列，结果Ｇ列改放在ＢＤ列，这代码帮我改一下，谢谢！！

Sub TT()
Dim I As Long, K As Long
Dim Ar(1 To 10000, 1 To 1)
For I = 2 To Range("b200000").End(xlUp).Row
If Cells(I, 1) <> Cells(I - 1, 1) Then
K = K + 2
Ar(K - 1, 1) = Cells(I, 1)
Ar(K, 1) = Cells(I, 3)
Else
K = K + 1
Ar(K, 1) = Cells(I, 3)
End If
Next
Range("g:g").ClearContents
Range("g1").Resize(K, 1) = Ar
End Sub

最佳答案

月排行榜 / 总排行榜

xdd_sky

2013-5-27 13:32

1. Sub TT()
   
2. Dim I As Long, K As Long
   
3. Dim Ar(1 To 10000, 1 To 1)
   
4. For I = 2 To Range("AY200000").End(xlUp).Row
   
5. If Cells(I, 50) <> Cells(I - 1, 50) Then
   
6. K = K + 2
   
7. Ar(K - 1, 1) = Cells(I, 50)
   
8. Ar(K, 1) = Cells(I, 52)
   
9. Else
   
10. K = K + 1
    
11. Ar(K, 1) = Cells(I, 52)
    
12. End If
    
13. Next
    
14. Range("BD:BD").ClearContents
    
15. Range("BD1").Resize(K, 1) = Ar
    
16. End Sub

复制代码

跳转到最佳答案楼层

1032446692

Sub TT()
    Range("A:C").Cut
    Range("AX:AZ").Select
    ActiveSheet.Paste
    Range("D:D").Cut
    Range("BD").Select
    ActiveSheet.Paste
End Sub

xdd_sky

1. Sub TT()
   
2. Dim I As Long, K As Long
   
3. Dim Ar(1 To 10000, 1 To 1)
   
4. For I = 2 To Range("AY200000").End(xlUp).Row
   
5. If Cells(I, 50) <> Cells(I - 1, 50) Then
   
6. K = K + 2
   
7. Ar(K - 1, 1) = Cells(I, 50)
   
8. Ar(K, 1) = Cells(I, 52)
   
9. Else
   
10. K = K + 1
    
11. Ar(K, 1) = Cells(I, 52)
    
12. End If
    
13. Next
    
14. Range("BD:BD").ClearContents
    
15. Range("BD1").Resize(K, 1) = Ar
    
16. End Sub

复制代码

1032446692

Sub TT()
    Dim I As Long, K As Long
    Dim Ar(1 To 10000, 1 To 1)
    For I = 2 To Range("AY200000").End(xlUp).Row
        If Cells(I, 50) <> Cells(I - 1, 50) Then
            K = K + 2
            Ar(K - 1, 1) = Cells(I, 50)
            Ar(K, 1) = Cells(I, 52)
        Else
            K = K + 1
            Ar(K, 1) = Cells(I, 52)
        End If
    Next
    Range("BD:BD").ClearContents
    Range("BD1").Resize(K, 1) = Ar
End Sub

1091126096

来学习的                       

fangniuji

1032446692 发表于 2013-5-27 13:40
Sub TT()
    Dim I As Long, K As Long
    Dim Ar(1 To 10000, 1 To 1)

谢谢你的帮忙，谢谢！！！！