Thêm dòng trống trong mảng ? (1 người xem)

[TrungChinhs]

Tôi muốn thêm dòng từ điều kiện dữ liệu trên mảng nhưng làm mãi không được. Nhờ các bạn xem giúp code sai ở đâu ? Thanks!

 

[dhn46]

Tôi muốn thêm dòng từ điều kiện dữ liệu trên mảng nhưng làm mãi không được. Nhờ các bạn xem giúp code sai ở đâu ? Thanks!

Phân tích 1 chút Code của bác TrungChinhs

Sub Themdong()
    data = [b5:e27] 'Nạp mảng
    ReDim arrkq(1 To UBound(data) * 2, 1 To 4) 'Khai báo dộ lớn Arrkq
    For i = 1 To UBound(data) 'Duyệt vòng lặp qua 1 lần data
        For j = 1 To 4 ' Duyệt các cột trong mảng
            arrkq(i, j) = data(i, j) 'Nếu dòng i cột j của arrkq = dòng i cột j data thì (arrkq ban đầu chưa có gì)
            If data(i, 4) > 0 Then 'Xét nếu data cột 4 dòng i >0 thì
                arrkq(x + 1, j) = "xxx" 'arrkq thêm 1 phần tử là "xxx"
            End If
        Next
        x = x + 1 ' x tăng 1 đơn vị khi vòng lặp qua data kết thúc
    Next
    [m5:p1000].Clear
    [m5].Resize(x, 4) = arrkq
End Sub

=> từ đó có thể thấy bác định lấy x làm biến để tạo cách dòng cho mảng mới, nhưng điều này nằm ngoài mong muốn vì x chỉ tăng 1 đơn vị khi i tăng 1 đơn vị => dẫn tới sai kết quả
Bác thử với Code sau

Sub Themdong1()
    Dim x As Long, i As Long
    Dim Data, Arrkq
    Data = [b5:e27]
    ReDim Arrkq(1 To UBound(Data) * 2, 1 To 4)
    For i = 1 To UBound(Data, 1)
        If Data(i, 4) > 0 Then
            x = x + 1
            For j = 1 To 4
                Arrkq(i + x, j) = "xxxxx"
                Arrkq(i + x - 1, j) = Data(i, j)
            Next
        Else
            For j = 1 To 4
                Arrkq(i + x, j) = Data(i, j)
            Next
        End If
    Next
    [m5:p1000].Clear
    [m5].Resize(i + x, 4) = Arrkq
End Sub

 

[hungpecc1]

Em cũng xin góp vui 1 đoạn code nho nhỏ
[GPECODE=vb]
Sub GPE()
Dim tmparr, Arr, item, rng As Range
Dim n As Long, iR1 As Long, iR2
[M51000].Clear
tmparr = [E5:E27]: iR2 = 4: iR1 = 5
For Each item In tmparr
iR2 = iR2 + 1
If item Like "x" Then
Arr = Range("B" & iR1, "E" & iR2)
Set rng = [M65536].End(3).Offset(2)
rng.Resize(iR2 - iR1 + 1, 4) = Arr
iR1 = iR2 + 1
End If
Next
End Sub
[/GPECODE]

 

[siwtom]

Tôi muốn thêm dòng từ điều kiện dữ liệu trên mảng nhưng làm mãi không được. Nhờ các bạn xem giúp code sai ở đâu ? Thanks!

Tôi chỉ sửa để có kết quả thôi

Sub Themdong()
Dim k As Long, i As Long
    Data = [b5:e27]
    ReDim ArrKq(1 To UBound(Data) * 2, 1 To 4)
    For i = 1 To UBound(Data)
        For j = 1 To 4
            ArrKq(i + k, j) = Data(i, j)
        Next
        If Data(i, 4) > 0 Then
            k = k + 1
        End If
    Next
    [m5:p1000].Clear
    [m5].Resize(i + k - 1, 4) = ArrKq
End Sub

 

[siwtom]

Em cũng xin góp vui 1 đoạn code nho nhỏ
[GPECODE=vb]
Sub GPE()
Dim tmparr, Arr, item, rng As Range
Dim n As Long, iR1 As Long, iR2
[M51000].Clear
tmparr = [E5:E27]: iR2 = 4: iR1 = 5
For Each item In tmparr
iR2 = iR2 + 1
If item Like "x" Then
Arr = Range("B" & iR1, "E" & iR2)
Set rng = [M65536].End(3).Offset(2)
rng.Resize(iR2 - iR1 + 1, 4) = Arr
iR1 = iR2 + 1
End If
Next
End Sub
[/GPECODE]

Hình như bị mất dữ liệu - cụt đuôi

 

[hungpecc1]

Hình như bị mất dữ liệu - cụt đuôi

^^Lại bị anh bắt lỗi , cốc vào đầu <------- Thanks anh !

em viết code trong tình trạng ngáp ngắn thở dài ( buồn ngủ ) ---> quên mất trường hợp không có dấu x.....

 

[TrungChinhs]

Do không biết "rút cột" trong mảng nên tôi định Tôi định đưa vào mảng các vùng dữ liệu không liên tục nhưng không biết code sai ở đâu ?
Nhờ các bạn xem giúp. Thanks !

Sub Test()
    Dim Arr, i As Long, j As Long
    DaTa = Range("[COLOR=#0000ff][B]b2:b10,d2:e10[/B][/COLOR]")
    ReDim Arr(1 To UBound(DaTa), 1 To 3)
    For i = 1 To UBound(DaTa)
        For j = 1 To 3
            [B][COLOR=#ff0000]Arr(i, j) = DaTa(i, j)[/COLOR][/B]
        Next
    Next
    [h5].Resize(UBound(DaTa), 3) = Arr
End Sub

 

[ptm0412]

Dữ liệu gồm nhiều vùng không liên tục thì:
- Không đưa vào 1 mảng được
- Do đó không tính được UBound

 

[sealand]

Do không biết "rút cột" trong mảng nên tôi định Tôi định đưa vào mảng các vùng dữ liệu không liên tục nhưng không biết code sai ở đâu ?
Nhờ các bạn xem giúp. Thanks !

Sub Test()
    Dim Arr, i As Long, j As Long
    DaTa = Range("[COLOR=#0000ff][B]b2:b10,d2:e10[/B][/COLOR]")
    ReDim Arr(1 To UBound(DaTa), 1 To 3)
    For i = 1 To UBound(DaTa)
        For j = 1 To 3
            [B][COLOR=#ff0000]Arr(i, j) = DaTa(i, j)[/COLOR][/B]
        Next
    Next
    [h5].Resize(UBound(DaTa), 3) = Arr
End Sub

Thì đưa cả mảng lớn rồi chọn cột:

Sub Test()
    Dim Arr, i As Long, j As Long
    DaTa = Range("b2:e10")
    ReDim Arr(1 To UBound(DaTa), 1 To 3)
    For i = 1 To UBound(DaTa)
        For j = 1 To 3
            Arr(i, j) = DaTa(i, j + IIf(j = 1, 0, 1))
        Next
    Next
    [h5].Resize(UBound(DaTa), 3) = Arr
End Sub

Nếu nhiều biến động về cột thì ta dùng hàm choose hay select case cho chắc ăn
Ví dụ:
----
Arr(i, j) = DaTa(i, Choose(j,1,3,4)
----)