Điền dữ liệu theo điều kiện gộp ô? (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,895
Được thích
1,219
Xin chào các bạn,
Nhờ các bạn giúp đỡ cho OT trường hợp sau với ạ.
 

File đính kèm

Xin chào các bạn,
Nhờ các bạn giúp đỡ cho OT trường hợp sau với ạ.
Bạn chạy thử cái sub này.
Mã:
Sub linhtinh()
    Dim arr, i As Long, arr1, a As Long, dk As Boolean
    arr = Range("f3:F29").Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 1)
    For i = 1 To UBound(arr, 1)
        If Len(arr(i, 1)) = 0 Then
           If dk = False Then
              a = a + 1: dk = True
              arr1(i - 1, 1) = "Group" & a
           End If
           arr1(i, 1) = "Group" & a
        Else
           dk = False
        End If
    Next i
        Range("g3:g29").Value = arr1
End Sub
 
Upvote 0
Xin chào các bạn,
Nhờ các bạn giúp đỡ cho OT trường hợp sau với ạ.
Tham khảo code:
Mã:
Sub Button1_Click()
Dim Rng As Range, i As Byte, j As Byte, k As Byte
Set Rng = Sheet1.Range("F3:F29")
For i = 1 To Rng.Rows.Count
    If Rng(i, 1).MergeCells Then
        j = Rng(i, 1).MergeArea.Rows.Count
        k = k + 1
        Cells(i + 2, "H").Resize(j) = "Group" & k
        i = i + j - 1
    End If
Next i
End Sub
 

File đính kèm

Upvote 0
Bạn chạy thử cái sub này.
Mã:
Sub linhtinh()
    Dim arr, i As Long, arr1, a As Long, dk As Boolean
    arr = Range("f3:F29").Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 1)
    For i = 1 To UBound(arr, 1)
        If Len(arr(i, 1)) = 0 Then
           If dk = False Then
              a = a + 1: dk = True
              arr1(i - 1, 1) = "Group" & a
           End If
           arr1(i, 1) = "Group" & a
        Else
           dk = False
        End If
    Next i
        Range("g3:g29").Value = arr1
End Sub
Góp vui bằng công thức:
H3 =IF(AND(F3<>"",F4=""),"Group"&COUNTIFS($F$3:F3,"<>",$F$4:F4,""),IF(F3="",H2,""))
Hóng giải pháp trường hợp cột F có giá trị rỗng.
 
Upvote 0
Upvote 0
Duyệt trên ô, đưa vào mảng:
Mã:
Sub Button1_Click()
Dim Rng As Range, i As Byte, j As Byte, k As Byte, reArr(), n As Byte
Set Rng = Sheet1.Range("F3:F29")
ReDim reArr(1 To Rng.Rows.Count, 1 To 1)
For i = 1 To Rng.Rows.Count
    n = 0: j = 0
    If Rng(i, 1).MergeCells Then
        k = k + 1
        j = Rng(i, 1).MergeArea.Rows.Count
        Do While n < j
            n = n + 1
            reArr(i + n - 1, 1) = "Group" & k
        Loop
        i = i + j - 1
    End If
Next i
Sheet1.Range("H3").Resize(Rng.Rows.Count) = reArr
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom