Anh/chị giúp e tách cột TK của sổ NKC thành 2 cột như mẫu e để ở sheet1. E xin cảm ơn !!! (1 người xem)

[loc.tt2012]

Anh/chị giúp e tách cột TK của sổ NKC thành 2 cột như mẫu e để ở sheet1. E xin cảm ơn !!!

 

[huuthang_bd]

giúp e tách

Đây nha bạn.....

 

[loc.tt2012]

Đây nha bạn.....

TKs nhé, admin xoá bài giúp e với ạ vì là nd của công ty ạ mà e quên xoá
A cho e hỏi học cái cách làm đó như thế nào v a?

 

[huuthang_bd]

Học VBA vài năm là làm được

 

[loc.tt2012]

dạ e cảm ơn a nhé, cho e hỏi thêm vba học như nào v ạ? có khoá học hay tự nghiên cứu v a?

 

[huuthang_bd]

Tự học hay tìm khóa học để học là tùy vào điều kiện của bạn chứ.

 

[HieuCD]

Anh/chị giúp e tách cột TK của sổ NKC thành 2 cột như mẫu e để ở sheet1. E xin cảm ơn !!!

Chỉnh mẫu lại dể nhìn hơn

Sub NKC()
  Dim sArr(), Res()
  Dim sRow&, i&, frow&, fR&, j&, no&, co&
  Dim tkNo$, tkCo$, tk911 As Boolean
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("SNKC")
    i = .Range("I" & Rows.Count).End(xlUp).Row
    If .Range("E" & i) <> Empty Then
      sArr = .Range("B3:I" & i).Value
    Else
      sArr = .Range("B3:I" & i + 1).Value
      sArr(UBound(sArr), 4) = "zzz"
    End If
  End With
 
  sRow = UBound(sArr) - 1
  ReDim Res(1 To sRow, 1 To 9)
  For i = 1 To sRow
    If sArr(i, 7) <> Empty Then
      no = no + 1: tkNo = sArr(i, 6)
    Else
      co = co + 1: tkCo = sArr(i, 6)
    End If
    If sArr(i, 4) <> Empty Then
      frow = i
      Res(k + 1, 1) = k + 1
      For j = 1 To 4
        Res(k + 1, j + 1) = sArr(i, j)
      Next j
    End If
    If sArr(i, 6) = "911" Then tk911 = True
    If sArr(i + 1, 4) <> Empty Then
      For r = frow To i
        If no = 1 Then
          If sArr(r, 8) > 0 Then
            k = k + 1
            Res(k, 6) = tkNo
            Res(k, 7) = sArr(r, 6)
            Res(k, 8) = sArr(r, 8)
          End If
        ElseIf co = 1 Then
          If sArr(r, 7) > 0 Then
            k = k + 1
            Res(k, 6) = sArr(r, 6)
            Res(k, 7) = tkCo
            Res(k, 8) = sArr(r, 7)
          End If
        ElseIf tk911 = True Then
          If sArr(r, 6) <> 911 Then
            If sArr(r, 7) > 0 Then
              k = k + 1
              Res(k, 6) = sArr(r, 6)
              Res(k, 7) = "911"
              Res(k, 8) = sArr(r, 7)
            Else
              k = k + 1
              Res(k, 6) = "911"
              Res(k, 7) = sArr(r, 6)
              Res(k, 8) = sArr(r, 8)
            End If
            Res(k, 9) = "k"
          Else
            Res(k, 9) = "Yes"
          End If
        Else
          If sArr(r, 7) > 0 Then
            k = k + 1
            If fR = 0 Then fR = k
            Res(k, 6) = sArr(r, 6)
            Res(k, 8) = sArr(r, 7)
            Res(k, 9) = "k"
          End If
          If r = i Then
            For r2 = frow To i
              If sArr(r2, 8) > 0 Then
                For i2 = fR To k
                  If Res(i2, 9) = "k" Then
                    If Res(i2, 8) = sArr(r2, 8) Then
                      Res(i2, 7) = sArr(r2, 6)
                      Res(i2, 9) = "Yes"
                      Exit For
                    End If
                  End If
                Next i2
              End If
            Next r2
          End If
        End If
      Next r
      no = 0: co = 0: tk911 = False
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("F" & Rows.Count).End(xlUp).Row
    If i > 2 Then .Range("A3:I" & i).Clear
    .Range("B3").Resize(k, 6).NumberFormat = "@"
    .Range("H3").Resize(k).NumberFormat = "#,###" '***
    .Range("A3").Resize(k, 8).Borders.LineStyle = 1
    .Range("A3").Resize(k, 8) = Res
  End With
End Sub