Nhờ các bạn giúp vòng lặp for... nex

[hiénlinh197]

Các bạn ơi giúp mình nhé!
Cảm ơn các bạn,

 

[hiénlinh197]

Các bạn ơi giúp mình nhé!
Cảm ơn các bạn,

Cái tô màu vàng là để nhìn rõ thôi, không cần định dạng các bạn à.
Cảm ơn các bạn quan tâm giúp đỡ nhé!

 

[♫ђöล♥ßล†♥†µ♫]

Các bạn ơi giúp mình nhé!
Cảm ơn các bạn,

Không biết có đúng ý của anh không ( 2 cái anh chọn cái nào thì chọn nha )

 Sub GPE()
    Dim Dic As Object, sArr(), I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 1)) Then Dic.Add sArr(I, 1), ""
    Next I
    .Range("B1").Resize(1, Dic.Count) = Dic.Keys
End With
Set Dic = Nothing
End Sub

Sub GPE1()
    Dim Rng As Range, n As Long, m As Long: n = 4: m = 4
    With Sheet1
        Set Rng = .Range("B1:G1")
        For I = 1 To n
            .Range("C" & m).Resize(Rng.Columns.Count).Value = Application.Transpose(Rng)
            m = m + Rng.Columns.Count
        Next I
    End With
End Sub

 

[hiénlinh197]

Không biết có đúng ý của anh không ( 2 cái anh chọn cái nào thì chọn nha )

 Sub GPE()
    Dim Dic As Object, sArr(), I As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 1)) Then Dic.Add sArr(I, 1), ""
    Next I
    .Range("B1").Resize(1, Dic.Count) = Dic.Keys
End With
Set Dic = Nothing
End Sub

Sub GPE1()
    Dim Rng As Range, n As Long, m As Long: n = 4: m = 4
    With Sheet1
        Set Rng = .Range("B1:G1")
        For I = 1 To n
            .Range("C" & m).Resize(Rng.Columns.Count).Value = Application.Transpose(Rng)
            m = m + Rng.Columns.Count
        Next I
    End With
End Sub

Cảm ơn bạn rất nhiều, còn cách nào khác nữa không hả bạn? Thật sự là mình đang muốn học bạn đừng cười mình nhé! (Cái vòng for....... nex nó loằng ngoằng khó hiểu mình không vận dụng được)

 

[Hoang2013]

. . . . . ,Còn cách nào khác nữa không hả bạn? Thật sự là mình đang muốn học bạn đừng cười mình nhé! (Cái vòng for....... nex nó loằng ngoằng khó hiểu mình không vận dụng được)

Thử với 2 vòng lặp xem sao:

Sub Chép4()
Dim J As Long, W As Long
Dim Cls As Range

[B3:B99].ClearContents     'Xóa Du Liêu Lân Chay Macro Truóc      '
[B3].Value = "GPE.COM"     'Gán Tri De Làm Môc         '
For J = 1 To 4             'Vòng Lap Duyêt Só Lân Chép '
    For Each Cls In Range([B1], [G1])   'Vòng Lap Duyêt Các Ô Càn Láy Két Qua       '
        [B100].End(xlUp).Offset(1).Value = Cls.Value
    Next Cls
Next J
[B3].Value = ""            'Xóa Móc Chép        '
End Sub

Sub Chép1()
Dim J As Long, W As Long
Dim Cls As Range:                      ReDim Arr(1 To 999, 1 To 1) As String

[b4].Resize(99).ClearContents
For J = 1 To 4                         'Vòng Lap Duyêt Só Lân  '
    For Each Cls In Range([B1], [G1])   'Vòng Lap Duyêt Các Ô Càn Láy Két Qua '
        'Chép Vô Mang Da Khai Báo       '
        W = W + 1:          Arr(W, 1) = Cls.Value
    Next Cls
Next J
[b4].Resize(W).Value = Arr()
End Sub