Nhờ sửa lỗi mảng trong VBA excel chuyển dữ liệu dòng thành cột (7 người xem)

[syquan]

Mình có dữ liệu nhiều dòng,cột theo chiều ngang và muốn chuyển thành một cột theo chiều dọc như hình

Mình đã viết code nhưng bị lỗi ở dòng tô đậm mong mọi người sửa giúp. Vì không biết sao lại lỗi.
Sub khanh()
Const dong_3 As Long = 3
Dim dong, lR As Long, i, j As Long, Res()
Dim a(), b(), c() As String
Dim Ws As Worksheet
Set Ws = Worksheets("DL")
Ws.Range("D4:F500").ClearContents
With Ws
lR = .Range("A" & Rows.Count).End(xlUp).Row
If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
a = .Range("A4:A" & lR + 1).Value2
b = .Range("B4:B" & lR + 1).Value2
c = .Range("C4:C" & lR + 1).Value2
lR = UBound(a, 1) - 1
ReDim Res(1 To lR * dong_3, 1 To 1)
For i = 1 To lR
j = (i - 1) * dong_3 + 1
Res(j, 1) = a(i, 1)
Res(j + 1, 1) = b(i, 1)
Res(j + 2, 1) = c(i, 1)
Next i
.Range("D4").Resize(lR * 3, 1).Value = Res
dong = Sheets("DL").Range("D" & Rows.Count).End(xlUp).Row
Sheets("DL").Range("D4" & dong).Copy
End With
End Sub

 

[phulien1902]

Mình có dữ liệu nhiều dòng,cột theo chiều ngang và muốn chuyển thành một cột theo chiều dọc như hình
View attachment 226051
Mình đã viết code nhưng bị lỗi ở dòng tô đậm mong mọi người sửa giúp. Vì không biết sao lại lỗi.
Sub khanh()
Const dong_3 As Long = 3
Dim dong, lR As Long, i, j As Long, Res()
Dim a(), b(), c() As String
Dim Ws As Worksheet
Set Ws = Worksheets("DL")
Ws.Range("D4:F500").ClearContents
With Ws
lR = .Range("A" & Rows.Count).End(xlUp).Row
If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
a = .Range("A4:A" & lR + 1).Value2
b = .Range("B4:B" & lR + 1).Value2
c = .Range("C4:C" & lR + 1).Value2
lR = UBound(a, 1) - 1
ReDim Res(1 To lR * dong_3, 1 To 1)
For i = 1 To lR
j = (i - 1) * dong_3 + 1
Res(j, 1) = a(i, 1)
Res(j + 1, 1) = b(i, 1)
Res(j + 2, 1) = c(i, 1)
Next i
.Range("D4").Resize(lR * 3, 1).Value = Res
dong = Sheets("DL").Range("D" & Rows.Count).End(xlUp).Row
Sheets("DL").Range("D4" & dong).Copy
End With
End Sub

Xài tạm:

Sub Test()
    Dim DL As Range, Cll As Range, k&
    Set DL = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
    For Each Cll In DL
        k = k + 1
        Cells(k + 3, 4) = Cll
    Next
End Sub

 

[syquan]

Xài tạm:

Sub Test()
    Dim DL As Range, Cll As Range, k&
    Set DL = Range(Range("A4"), Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
    For Each Cll In DL
        k = k + 1
        Cells(k + 3, 4) = Cll
    Next
End Sub

Bạn có thể giúp mình chuyển thành dạng như bên dưới được không ah. Cảm ơn bạn nhiều!

 

[snow25]

Mình có dữ liệu nhiều dòng,cột theo chiều ngang và muốn chuyển thành một cột theo chiều dọc như hình
View attachment 226051
Mình đã viết code nhưng bị lỗi ở dòng tô đậm mong mọi người sửa giúp. Vì không biết sao lại lỗi.
Sub khanh()
Const dong_3 As Long = 3
Dim dong, lR As Long, i, j As Long, Res()
Dim a(), b(), c() As String
Dim Ws As Worksheet
Set Ws = Worksheets("DL")
Ws.Range("D4:F500").ClearContents
With Ws
lR = .Range("A" & Rows.Count).End(xlUp).Row
If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
a = .Range("A4:A" & lR + 1).Value2
b = .Range("B4:B" & lR + 1).Value2
c = .Range("C4:C" & lR + 1).Value2
lR = UBound(a, 1) - 1
ReDim Res(1 To lR * dong_3, 1 To 1)
For i = 1 To lR
j = (i - 1) * dong_3 + 1
Res(j, 1) = a(i, 1)
Res(j + 1, 1) = b(i, 1)
Res(j + 2, 1) = c(i, 1)
Next i
.Range("D4").Resize(lR * 3, 1).Value = Res
dong = Sheets("DL").Range("D" & Rows.Count).End(xlUp).Row
Sheets("DL").Range("D4" & dong).Copy
End With
End Sub

Sửa 1 chút của bạn.

Sub khanh()
    Const dong_3 As Long = 3
    Dim dong, lR As Long, i, j As Long, Res()
    Dim a(), b(), c() As String, k As Long
    Dim Ws As Worksheet
    Set Ws = Worksheets("DL")
    Ws.Range("D4:D500").ClearContents
    With Ws
        lR = .Range("A" & Rows.Count).End(xlUp).Row
        If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
        a = .Range("A4:C" & lR).Value2
        lR = UBound(a, 1)
        ReDim Res(1 To lR * dong_3, 1 To 1)
        For i = 1 To lR
            For j = 1 To 3
                k = k + 1
                Res(k, 1) = a(i, j)
            Next j
        Next i
        .Range("D4").Resize(k, 1).Value = Res
    End With
End Sub

 

[syquan]

Sửa 1 chút của bạn.

Sub khanh()
    Const dong_3 As Long = 3
    Dim dong, lR As Long, i, j As Long, Res()
    Dim a(), b(), c() As String, k As Long
    Dim Ws As Worksheet
    Set Ws = Worksheets("DL")
    Ws.Range("D4:D500").ClearContents
    With Ws
        lR = .Range("A" & Rows.Count).End(xlUp).Row
        If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
        a = .Range("A4:C" & lR).Value2
        lR = UBound(a, 1)
        ReDim Res(1 To lR * dong_3, 1 To 1)
        For i = 1 To lR
            For j = 1 To 3
                k = k + 1
                Res(k, 1) = a(i, j)
            Next j
        Next i
        .Range("D4").Resize(k, 1).Value = Res
    End With
End Sub

Giúp em sửa lại xử lý ở dòng số 4: chèn thêm 4 ô trống rồi đến "I01", "HZ", dữ liệu cột B4 và C4. Lặp lại cho các dòng tiếp theo.
Cảm ơn anh nhiều ah

 

[Ba Tê]

Giúp em sửa lại xử lý ở dòng số 4: chèn thêm 4 ô trống rồi đến "I01", "HZ", dữ liệu cột B4 và C4. Lặp lại cho các dòng tiếp theo.

Bạn thử Sub này:

Option Explicit
Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
Dim Txt1 As String, Txt2 As String
    Txt1 = "I01":   Txt2 = "HZ"
    sArr = Range("A4", Range("A10000").End(xlUp)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 9, 1 To 1)
For I = 1 To R
    K = K + 1
    dArr(K, 1) = sArr(I, 1)
    K = K + 5
    dArr(K, 1) = Txt1
    dArr(K + 1, 1) = Txt2
    dArr(K + 2, 1) = sArr(I, 2)
    dArr(K + 3, 1) = sArr(I, 3)
    K = K + 3
Next I
  Range("E4:E10000").ClearContents
  Range("E4").Resize(K) = dArr
End Sub

 

[thuyyeu99]

Mình có dữ liệu nhiều dòng,cột theo chiều ngang và muốn chuyển thành một cột theo chiều dọc như hình
View attachment 226051
Mình đã viết code nhưng bị lỗi ở dòng tô đậm mong mọi người sửa giúp. Vì không biết sao lại lỗi.
Dim a(), b(), c() As String

Bạn đổi lại As variant thử xem sao

 

[dangkhoiLK]

Sửa 1 chút của bạn.

Sub khanh()
    Const dong_3 As Long = 3
    Dim dong, lR As Long, i, j As Long, Res()
    Dim a(), b(), c() As String, k As Long
    Dim Ws As Worksheet
    Set Ws = Worksheets("DL")
    Ws.Range("D4:D500").ClearContents
    With Ws
        lR = .Range("A" & Rows.Count).End(xlUp).Row
        If lR <= 3 Then MsgBox "Khong co du lieu.": Exit Sub
        a = .Range("A4:C" & lR).Value2
        lR = UBound(a, 1)
        ReDim Res(1 To lR * dong_3, 1 To 1)
        For i = 1 To lR
            For j = 1 To 3
                k = k + 1
                Res(k, 1) = a(i, j)
            Next j
        Next i
        .Range("D4").Resize(k, 1).Value = Res
    End With
End Sub

Tại sao phải dùng Value2

 

[VetMini]

Tại sao phải dùng Value2

Tại vì có một tay cốt rất chiến bảo rằng va lu tu rất hiệu quả so với va lu.
Ở đây không ai đủ trình độ cãi lại tay nghề của người này nên đành theo răm rắp. Vả lại, dân GPE rất tôn sùng tốc độ cho nên nghe "va lu tu nhanh hơn" là khoái rồi.
Nếu bạn nghĩ rằng mình đủ sức thì vào thớt ấy mà cãi.
Hình như tên thớt đó là Undocument Windows API... [sic]
(tôi chỉ nói là người này rất chiến về nghề cốt kiếc chứ tôi không hề nói về nghề in lịch nhé)

 

[batman1]

(tôi chỉ nói là người này rất chiến về nghề cốt kiếc chứ tôi không hề nói về nghề in lịch nhé)

Theo tôi thì phải là "In gờ li xờ". Nhưng trình độ tôi chỉ ở mức "luôn cầm từ điển trong tay" nên có thể tôi sai.

 

[dangkhoiLK]

Tôi thì không biết ai dung ai sai. Theo tôi value2 là dữ liệu thô thì dĩ nhiên nó phải lẹ hơn dữ liệu qua xử lý là value 1 chút. Tuy nhiên lẹ hơn mà đơn vị tính bằng gì.... Có cần phải so sánh không. Theo tôi thì tôi vẫn dùng value. Tùy theo sở thích mỗi người. Nói qua nói lại làm gì

 

[batman1]

Tôi thì không biết ai dung ai sai. Theo tôi value2 là dữ liệu thô thì dĩ nhiên nó phải lẹ hơn dữ liệu qua xử lý là value 1 chút. Tuy nhiên lẹ hơn mà đơn vị tính bằng gì.... Có cần phải so sánh không. Theo tôi thì tôi vẫn dùng value. Tùy theo sở thích mỗi người. Nói qua nói lại làm gì

Nhưng có người trong VBA Excel đếm từng ms, phần nghìn của ms đấy. Đã có kịch hay mà bác VetMini được xem về chuyện này.

 

[snow25]

Tại sao phải dùng Value2

Thực ra code không phải mình viết.Mình chỉ chỉnh thôi.Mình hay dùng Value2 để nó cho dữ liệu đầu vào là ngày tháng năm nó chuyển thành dạng số thôi.Còn về tốc độ thì mình cũng không để ý lắm.