Nhờ giúp đỡ code tổng hợp dữ liệu từ nhiều hàng thành một cột

Eric.Shen · 5/6/23

Chào các bác!
Em đang có một bài toán là cần tổng hợp dữ liệu từ nhiều hàng thành một cột, bỏ qua trộn ô, bỏ qua ô trống
Dữ liệu và mô tả kết quả như tệp em đính kèm
Các bác giúp em với, em cảm ơn ạ!

bebo021999 · 5/6/23

Xài đỡ:

PHP:

Option Explicit

Sub ConvertRangeToColumn()
Dim i&, j&, k&, rng, res(1 To 10000, 1 To 1)
rng = Range("B2:N5").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        If Not IsEmpty(rng(i, j)) Then
            k = k + 1: res(k, 1) = rng(i, j)
        End If
    Next
Next
If k > 0 Then
    Range("F9:F10000").ClearContents
    Range("F9").Resize(k, 1).Value = res
End If
End Sub

Eric.Shen · 5/6/23

bebo021999 đã viết:

Xài đỡ:

PHP:

Option Explicit

Sub ConvertRangeToColumn()
Dim i&, j&, k&, rng, res(1 To 10000, 1 To 1)
rng = Range("B2:N5").Value
For i = 1 To UBound(rng)
    For j = 1 To UBound(rng, 2)
        If Not IsEmpty(rng(i, j)) Then
            k = k + 1: res(k, 1) = rng(i, j)
        End If
    Next
Next
If k > 0 Then
    Range("F9:F10000").ClearContents
    Range("F9").Resize(k, 1).Value = res
End If
End Sub

Ra đúng kết quả rồi bác ạ
Em cảm ơn bác nhiều nhé!

SA_DQ · 5/6/23

Chậm hơn chàng BeBo rồi!

BỔN PHẬN ĐÀN ÔNG

Đàn ông tất dê khi có dịp
Bản tính trời ban, trẻ đến già
Đàn ông bất luận còn da
Còn thoi thớp thở đàn bà là mê

Lâu nay pháp luật gao gắt phạt
Thúc thủ, vẫn không tởn đến già
Rón rén luật pháp xé ra
Hoàn nguyên chính hiệu đó là máu dê

/(hi nào huyết quản chưa ngừng chảy
Vẫn còn lưu mộng luyến với mơ
Tuy già vẫn dụ trẻ thơ
2uên đi tuổi tác bơ fờ ta long!

VetMini · 5/6/23

SA_DQ đã viết:
Chậm hơn chàng BeBo rồi!

Cũng nên tự hào là có người bắt đầu theo đường lối code của bạn, dùng ngữ pháp thượng cổ (dấu hai chấm để nối nhiều lệnh thành 1 dòng)

bebo021999 · 5/6/23

SA_DQ đã viết:
Chậm hơn chàng BeBo rồi!

Dạ sư phụ, vì bài này thuộc dạng căn bản nên các sư phụ chê, nên mới đến lượt đệ tử múa rìu.

longtay1111 · 5/6/23

Eric.Shen đã viết:
Chào các bác!
Em đang có một bài toán là cần tổng hợp dữ liệu từ nhiều hàng thành một cột, bỏ qua trộn ô, bỏ qua ô trống
Dữ liệu và mô tả kết quả như tệp em đính kèm
Các bác giúp em với, em cảm ơn ạ!

Bạn thử tại F9

F9=INDIRECT(TEXT(AGGREGATE(15,6,ROW($B$2:$N$5)*10^3+COLUMN($B$2:$N$5)/($B$2:$N$5>0),ROW(A1)),"R000C000"),0)

Eric.Shen · 5/6/23

vâng, em cảm ơn bác nhiều nhé

longtay1111 đã viết:
Bạn thử tại F9

F9=INDIRECT(TEXT(AGGREGATE(15,6,ROW($B$2:$N$5)*10^3+COLUMN($B$2:$N$5)/($B$2:$N$5>0),ROW(A1)),"R000C000"),0)

Bài đã được tự động gộp: 5/6/23

bebo021999 đã viết:
Dạ sư phụ, vì bài này thuộc dạng căn bản nên các sư phụ chê, nên mới đến lượt đệ tử múa rìu.

Bác ơi,
trường hợp em ẩn 1 hàng và em muốn câu lệnh bỏ qua nó thì em cần làm thế nào ạ?

VetMini · 5/6/23

longtay1111 đã viết:
Bạn thử tại F9

F9=INDIRECT(TEXT(AGGREGATE(15,6,ROW($B$2:$N$5)*10^3+COLUMN($B$2:$N$5)/($B$2:$N$5>0),ROW(A1)),"R000C000"),0)

Cỡ công thức khủng này mà dám dùng hàm indirect thì bạo thật.

huhumalu · 5/6/23

Mạn phép múa que trước mặt các anh

(

PHP:

Sub ConvertRangeToColumn()
    Dim i As Long
    Dim j As Long
    Dim inputRange As Range
    Dim outputRange As Range
    Dim row As Range
    Dim Arr() As Variant
    
    Set inputRange = Sheets("Sheet1").Range("B2:N5")
    Set outputRange = Sheets("Sheet1").Range("F9")
    
    For Each row In inputRange.Rows
        If Not row.Hidden Then
            For i = 1 To inputRange.Columns.Count
                If Not IsEmpty(row.Cells(1, i).Value) Then
                    j = j + 1
                    ReDim Preserve Arr(1 To 1, 1 To j) ' Tăng kích thước của mảng tạm
                    Arr(1, j) = row.Cells(1, i).Value ' Lưu giá trị vào mảng tạm
                End If
            Next i
        End If
    Next row
    
    outputRange.Resize(j - 1, 1).Value = WorksheetFunction.Transpose(Arr)
End Sub

VetMini · 5/6/23

huhumalu đã viết:
Mạn phép múa que trước mặt các anh (
...

Quả có múa thật.
1. Khi đặt tên biến, tránh những tên có thể đụng chạm với object/enum của VBA.
Điển hình: row.
2. Tránh tối đa việc Redim Reserve bên trong vòng lặp. Trừ phi biết chắc chắn số lần lặp khá nhỏ.
Bạn có biết mỗi lần gặp lệnh này thì VBA phải làm gì không?
Thà là tạo một mảng khá lớn rồi giới hạn số dòng cần chép xuống trang tính.

bebo021999 · 5/6/23

Eric.Shen đã viết:
trường hợp em ẩn 1 hàng và em muốn câu lệnh bỏ qua nó thì em cần làm thế nào ạ?

Muốn bỏ qua dòng nào? Code dưới thêm 1 dòng, ví dụ bỏ qua dòng 2:

PHP:

Option Explicit

Sub ConvertRangeToColumn()
Dim i&, j&, k&, rng, res(1 To 10000, 1 To 1)
rng = Range("B2:N5").Value
For i = 1 To UBound(rng)
    If i <> 2 Then ' Neu muon bo qua dong 2 (E,F,A)
        For j = 1 To UBound(rng, 2)
            If Not IsEmpty(rng(i, j)) Then
                k = k + 1: res(k, 1) = rng(i, j)
            End If
        Next
    End If
Next
If k > 0 Then
    Range("F9:F10000").ClearContents
    Range("F9").Resize(k, 1).Value = res
End If
End Sub

Eric.Shen · 5/6/23

bebo021999 đã viết:

Muốn bỏ qua dòng nào? Code dưới thêm 1 dòng, ví dụ bỏ qua dòng 2:

PHP:

Option Explicit

Sub ConvertRangeToColumn()
Dim i&, j&, k&, rng, res(1 To 10000, 1 To 1)
rng = Range("B2:N5").Value
For i = 1 To UBound(rng)
    If i <> 2 Then ' Neu muon bo qua dong 2 (E,F,A)
        For j = 1 To UBound(rng, 2)
            If Not IsEmpty(rng(i, j)) Then
                k = k + 1: res(k, 1) = rng(i, j)
            End If
        Next
    End If
Next
If k > 0 Then
    Range("F9:F10000").ClearContents
    Range("F9").Resize(k, 1).Value = res
End If
End Sub

Em cảm ơn bác,
với trường hợp 1 dòng bất kỳ nào đó bị ẩn đi thì em phải sửa thế nào ạ, tức là cái code nó chỉ quét những dữ liệu hiển thị ấy ạ, bác giúp em với nhé

Bài đã được tự động gộp: 5/6/23

huhumalu đã viết:

Mạn phép múa que trước mặt các anh

(

PHP:

Sub ConvertRangeToColumn()
    Dim i As Long
    Dim j As Long
    Dim inputRange As Range
    Dim outputRange As Range
    Dim row As Range
    Dim Arr() As Variant
   
    Set inputRange = Sheets("Sheet1").Range("B2:N5")
    Set outputRange = Sheets("Sheet1").Range("F9")
   
    For Each row In inputRange.Rows
        If Not row.Hidden Then
            For i = 1 To inputRange.Columns.Count
                If Not IsEmpty(row.Cells(1, i).Value) Then
                    j = j + 1
                    ReDim Preserve Arr(1 To 1, 1 To j) ' Tăng kích thước của mảng tạm
                    Arr(1, j) = row.Cells(1, i).Value ' Lưu giá trị vào mảng tạm
                End If
            Next i
        End If
    Next row
   
    outputRange.Resize(j - 1, 1).Value = WorksheetFunction.Transpose(Arr)
End Sub

Em cảm ơn bác ạ

huhumalu · 5/6/23

VetMini đã viết:
Quả có múa thật.
1. Khi đặt tên biến, tránh những tên có thể đụng chạm với object/enum của VBA.
Điển hình: row.
2. Tránh tối đa việc Redim Reserve bên trong vòng lặp. Trừ phi biết chắc chắn số lần lặp khá nhỏ.
Bạn có biết mỗi lần gặp lệnh này thì VBA phải làm gì không?
Thà là tạo một mảng khá lớn rồi giới hạn số dòng cần chép xuống trang tính.

Cảm ơn anh. Em chỉnh lại:

PHP:

Option Explicit
Sub ConvertRangeToColumn()
    Dim i As Long
    Dim j As Long
    Dim inputRange As Range
    Dim outputRange As Range
    Dim rws As Range
    Dim Arr() As Variant
    
    Set inputRange = Sheets("Sheet1").Range("B2:N5")
    Set outputRange = Sheets("Sheet1").Range("F9")
          outputRange.Resize(1000, 1).ClearContents

    ReDim Arr(1 To 1, 1 To 1000)
    
    For Each rws In inputRange.Rows
        If Not rws.Hidden Then
            For i = 1 To inputRange.Columns.Count
                If Not IsEmpty(rws.Cells(1, i).Value) Then
                    j = j + 1
                    Arr(1, j) = rws.Cells(1, i).Value
                End If
            Next i
        End If
    Next rws
    outputRange.Resize(j, 1).Value = WorksheetFunction.Transpose(Arr)
End Sub

befaint · 5/6/23

huhumalu đã viết:
ReDim Arr(1 To 1, 1 To 1000)

Số 1000 đó xác định được theo inputRange mà bạn.

VetMini · 5/6/23

huhumalu đã viết:
Cảm ơn anh. Em chỉnh lại:

PHP:

Option Explicit ... ReDim Arr(1 To 1, 1 To 1000) ... outputRange.Resize(j, 1).Value = WorksheetFunction.Transpose(Arr) End Sub

1. ReDim bằng hằng số như vậy thì uổng công. Trừ phi bạn cần ReDim nhiều lần trong code.
Nếu bạn biết chắc nó không vượt qua con số 1000 thì dùng mảng tĩnh.
Dim (1 To 1000, 1 To 1)
Mãng tĩnh truy cập nhanh hơn mảng động. Chỉ bị là không "redim" lại được thôi.
Nếu vẫn muốn dùng mảng động thì theo như bài #15, đặt luôn số dòng tối đa. Thời buổi máy tính 64 bit địa chỉ, viecj tiết kiệm bộ nhớ gần như không thành vấn đề. Trừ phi function/sub của bạn là đệ quy.

2. Người ta dùng Transpose là tại vì ở code bài trước, chiều cuối cùng của mảng (ở đây là chiều thứ 2) mới Redim Preserved được.
Qua code sửa lại, bạn không dùng lệnh này nữa thì cứ chiều thứ nhất là dòng, chiều thứ hai là cột cho khỏe.

huhumalu · 6/6/23

Đúng là em chưa suy nghĩ thấu đáo hết mọi chuyện.

Nhờ giúp đỡ code tổng hợp dữ liệu từ nhiều hàng thành một cột

Eric.Shen

Thành viên chính thức

File đính kèm

bebo021999

Thành viên gạo cội

Eric.Shen

Thành viên chính thức

SA_DQ

/(hông là gì!

VetMini

Ăn cùng góc phố

bebo021999

Thành viên gạo cội

longtay1111

Thành viên hoạt động

File đính kèm

Eric.Shen

Thành viên chính thức

VetMini

Ăn cùng góc phố

huhumalu

Thành viên tiêu biểu

VetMini

Ăn cùng góc phố

bebo021999

Thành viên gạo cội

Eric.Shen

Thành viên chính thức

huhumalu

Thành viên tiêu biểu

befaint

|||||||||||||

VetMini

Ăn cùng góc phố

huhumalu

Thành viên tiêu biểu

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng