Tim tên và số trận đấu (1 người xem)

[theducthethao591]

Qua tìm hiểu hôm nay em xin phép được đăng bài, nhờ các anh, chị, em giúp đỡ giùm em; em có kèm theo file và chú thích, rất mong nhận được sự giúp đỡ từ các anh, chị, em nhiều, cảm ơn anh, chị nhiều ạ

 

[HieuCD]

Qua tìm hiểu hôm nay em xin phép được đăng bài, nhờ các anh, chị, em giúp đỡ giùm em; em có kèm theo file và chú thích, rất mong nhận được sự giúp đỡ từ các anh, chị, em nhiều, cảm ơn anh, chị nhiều ạ

Kiểm tra lại . . .

Option Explicit

Sub xyz()
  Dim arr(), res(), hcD As Boolean
  Dim sRow&, i&, k&, phai$, giai$, tp$, tg$, tv3$
 
  arr = Sheets("SD").Range("A5:E" & Sheets("SD").Range("B1000000").End(xlUp).Row).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 3)
 
  For i = 1 To sRow 'Vong 1
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 1 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 2) <> Empty And IsNumeric(arr(i, 2)) Then
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 2)
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 2)
        End If
      End If
    End If
  Next i
 
  For i = 1 To sRow 'Vong 2
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 2 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 3) <> Empty And IsNumeric(arr(i, 3)) Then '*** 3
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 3) '*** 3
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 3) '*** 3
        End If
      End If
    End If
  Next i
 
  For i = 1 To sRow 'Vong 3
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 3 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 4) <> Empty And IsNumeric(arr(i, 4)) Then '*** 4
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 4) '*** 4
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 4) '*** 4
          If tv3 <> Empty Then
            res(k, 2) = res(k, 2) & ";" & tv3
            tv3 = Empty
          End If
        End If
      End If
      If arr(i, 5) <> Empty And IsNumeric(arr(i, 5)) Then tv3 = arr(i, 5)
    Else
      If arr(i, 2) <> Empty And IsNumeric(arr(i, 2)) Then
        res(k, 2) = arr(i, 2) & ";" & res(k, 2)
      End If
    End If
  Next i
  Sheets("SD").Range("O5").Resize(sRow, 3) = res
End Sub

 

[theducthethao591]

Kiểm tra lại . . .

Option Explicit

Sub xyz()
  Dim arr(), res(), hcD As Boolean
  Dim sRow&, i&, k&, phai$, giai$, tp$, tg$, tv3$
 
  arr = Sheets("SD").Range("A5:E" & Sheets("SD").Range("B1000000").End(xlUp).Row).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 3)
 
  For i = 1 To sRow 'Vong 1
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 1 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 2) <> Empty And IsNumeric(arr(i, 2)) Then
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 2)
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 2)
        End If
      End If
    End If
  Next i
 
  For i = 1 To sRow 'Vong 2
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 2 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 3) <> Empty And IsNumeric(arr(i, 3)) Then '*** 3
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 3) '*** 3
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 3) '*** 3
        End If
      End If
    End If
  Next i
 
  For i = 1 To sRow 'Vong 3
    If arr(i, 1) Like "## Kg *" Then
      If arr(i, 1) Like "*Nam*" Then phai = "Nam" Else phai = "Nu"
      giai = arr(i, 1)
      hcD = False
      If tp <> phai Then
        res(k + 1, 1) = "Vòng 3 " & phai
        tp = phai
      End If
    End If
    If arr(i, 2) Like "*Tranh Huy Ch??ng ??ng*" Then hcD = True
    If hcD = False Then
      If arr(i, 4) <> Empty And IsNumeric(arr(i, 4)) Then '*** 4
        If tg <> giai Then
          k = k + 1
          res(k, 2) = arr(i, 4) '*** 4
          res(k, 3) = giai
          tg = giai
        Else
          res(k, 2) = res(k, 2) & ";" & arr(i, 4) '*** 4
          If tv3 <> Empty Then
            res(k, 2) = res(k, 2) & ";" & tv3
            tv3 = Empty
          End If
        End If
      End If
      If arr(i, 5) <> Empty And IsNumeric(arr(i, 5)) Then tv3 = arr(i, 5)
    Else
      If arr(i, 2) <> Empty And IsNumeric(arr(i, 2)) Then
        res(k, 2) = arr(i, 2) & ";" & res(k, 2)
      End If
    End If
  Next i
  Sheets("SD").Range("O5").Resize(sRow, 3) = res
End Sub

Cảm ơn anh rất nhiều đúng như ý tưởng, em muốn thêm là cho vòng 1 và vòng 2 đấu luôn anh, nhờ anh có thể chỉnh sửa lại giúp, em có đính kèm file; cảm ơn anh rất nhiều ạ.