ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð°Ý²Î­p¦r¦ê¤º²Å¦Xªº¯S©w±ø¥ó¦¹µ{¦¡½X,¥i¦p¦ó§ïµ½©O?

[µo°Ý] ½Ð°Ý²Î­p¦r¦ê¤º²Å¦Xªº¯S©w±ø¥ó¦¹µ{¦¡½X,¥i¦p¦ó§ïµ½©O?

¥»©«³Ì«á¥Ñ starry1314 ©ó 2018-9-5 09:54 ½s¿è

½Ð±Ð½d¨Ò.rar (19.2 KB)

Q:¥Ø«eµ{¦¡½XINSTR·|­«½Æ²Î­p¥]§tªº­È¨Ò(AK,K)


¬G·Q®M¥Î¦¹¤½¦¡¨ú¥X©Ò­nªº¥N¸¹«á¦A¶i¦æ§PÂ_

¦]¦b¨Ï¥ÎVBA©I¥s¤º«Ø¨ç¼Æ·|°õ¦æ¥¢±Ñ( ¤£¯à¥Î°}¦C?)  


If Application.WorksheetFunction.Mid(A, 3,Match(, 0 * Mid(A, {4, 5, 6, 7, 8, 9}, 1), 1)) = arr(1, J) Then Jm = J:Exit For

½Ð°Ý¥i«ç¼Ë§ï¼g©O??



  1. Sub ²Î­p¤£ÄÝ©ó¥k°¼¥N¸¹¤§¼Æ¶q()
  2. Dim A, xD, arr, Brr, J&, Jm&, k%
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. arr = [¤u§@ªí1!H1:X1]
  5. ReDim Brr(1 To 2, 1 To UBound(arr, 2))
  6. For Each A In Range([¤u§@ªí1!A2], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
  7.     If A = "0" Or xD(A) = 1 Then GoTo 101
  8.     Jm = 1
  9.     For J = 1 To UBound(arr, 2) ' Step 2
  10.         If InStr(A, arr(1, J)) Then Jm = J: Exit For
  11.     Next J
  12.     If InStr(A, "V") Then k = 2 Else k = 1
  13.     Brr(k, Jm) = Brr(k, Jm) + 1
  14.     xD(A) = 1
  15. 101: Next
  16. With Sheets("¤u§@ªí1")
  17. .Range("G3:G4") = Brr
  18. End With
  19. End Sub
½Æ»s¥N½X

  1. Sub ²Î­p¥k°¼¥N¸¹¤§¼Æ¶q()

  2. Dim i
  3. For i = 8 To 25 'Cells(3, ActiveSheet.Columns.Count).End(xlToLeft).Column  '18 '????
  4. 'Cells(5, ActiveSheet.Columns.Count).End(xlToLeft).Column 1
  5. Dim A, xD, t$(1), n&(1), ¦r¼Æ


  6. Set xD = CreateObject("Scripting.Dictionary")
  7. ?r?? = LenB(StrConv(Sheets("¤u§@ªí1").Cells(2, i), vbFromUnicode))

  8. t(0) = Mid(Sheets("¤u§@ªí1").Cells(2, i), 1, ¦r¼Æ - 1)
  9. t(1) = Mid(Sheets("¤u§@ªí1").Cells(2, i), ¦r¼Æ, 1)

  10. For Each A In Range([¤u§@ªí1!A2], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
  11.     If A = "0" Or xD(A) = 1 Then GoTo 101
  12.     If InStr(A, t(0)) Then
  13.         If InStr(A, t(1)) Then n(1) = n(1) + 1 Else n(0) = n(0) + 1
  14.     End If
  15.     xD(A) = 1
  16. 101: Next
  17. Sheets("¤u§@ªí1").Cells(3, i) = n(0)
  18. Sheets("¤u§@ªí1").Cells(4, i) = n(1)

  19. xD.RemoveAll
  20. Erase t

  21. Erase n
  22. A = ""
  23. Next
½Æ»s¥N½X

³o¸Ì¿ù¤F:
For Each A In Range([¤u§@ªí1!A2], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp)(3)).Value
For Each A In Range([¤u§@ªí1!A2], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp)).Value

TOP

¦^´_ 2# ikboy


    ·PÁ´£¿ô~¤w­×¥¿
½d¨ÒÀɼƶq¤w¥¿½T~
¦ý·í§Ú§â¥Ø«e©Ò¦³½s¸¹³£¤W¥h¤§«á,ÁÙ¬O¤S«ì´_¤@¼Ëªº±¡ªp¤F

¹³¤@¶}©l»¡ªº  ¥u¦³¤@­Ó½s¸¹¬°Dªº   ¨Ò¦p¹³¦bD»PAD³£·|+1
½Ð±Ð½d¨Ò-1.rar (37.67 KB)

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2018-9-6 14:46 ½s¿è

¦^´_ 3# starry1314

Sub ²Î­p¤£ÄÝ©ó¥k°¼()
Dim A, xD, Arr, j&, Jm%, k%, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = [F1:Y2]
For j = 1 To UBound(Arr, 2)
    xD(Arr(1, j)) = j: Arr(1, j) = "": Arr(2, j) = ""
Next j

For Each A In Range([A2], [A1].Cells(Rows.Count, 1).End(xlUp)).Value
    T = Mid(A, 3): If T = "" Then GoTo 101
    For j = 1 To Len(T)
        If Val(Mid(T, j, 1) & 1) Then T = Left(T, j - 1): Exit For
    Next
    k = 1: If Right(A, 1) = "V" Then k = 2
    Jm = xD(T)
    If Jm = 0 Then Arr(k, 1) = Val(Arr(k, 1)) + 1: GoTo 101
    Arr(k, Jm) = Val(Arr(k, Jm)) + 1
    Arr(k, 2) = Val(Arr(k, 2)) + 1
101: Next
[F3].Resize(2, UBound(Arr, 2)) = Arr
End Sub

TOP

¥»©«³Ì«á¥Ñ starry1314 ©ó 2018-9-6 17:17 ½s¿è

¦^´_ 4# ­ã´£³¡ªL


·Q½Ð°Ý¦]½s¸¹·|¦³­«½Æª¬ªpªº¸Ü~¦¹µ{¦¡Åܦ¨·|­«½Æ­pºâ
¦p¦ó§ó§ï¥iÅý¦p 10AD07C2 ¦³10­Ó ¦ý¥u·|ºâ¤@­Ó©O
  1. Sub ¨ú¤£­«½Æ­È()

  2. Dim d As Object
  3. Dim lRow As Long
  4. Dim i As Long
  5. Dim str As Variant
  6. Dim strKey As String
  7. Set d = CreateObject("scripting.dictionary")
  8. lRow = Range("A65536").End(xlUp).Row
  9. str = Range("A1:A" & lRow + 1)
  10. For i = 1 To lRow
  11.     strKey = str(i, 1)
  12.     If strKey <> "" Then d(strKey) = ""
  13. Next i
  14. If d.Count Then [B1].Resize(d.Count) = Application.Transpose(d.keys)
  15. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ starry1314 ©ó 2018-9-6 18:27 ½s¿è

¦^´_ 4# ­ã´£³¡ªL


    ¥Ø«e§ï¼g¬°³o¼Ë
¦ý¤£ª¾«ç»ò½Õ¾ãE&f&gÄ檺¼Æ¶q...
  1. Sub ²Î­p¤£ÄÝ©ó¥k°¼()
  2. Set xD = CreateObject("Scripting.Dictionary")
  3. Set xC = CreateObject("Scripting.Dictionary")
  4. Arr = [F1:Y2]
  5. For j = 1 To UBound(Arr, 2)
  6.     xD(Arr(1, j)) = j: Arr(1, j) = "": Arr(2, j) = ""
  7. Next j

  8. For Each A In Range([A2], [A1].Cells(Rows.Count, 1).End(xlUp)).Value
  9.     T = Mid(A, 3): If T = "" Then GoTo 101
  10.     For j = 1 To Len(T)
  11.         If Val(Mid(T, j, 1) & 1) Then T = Left(T, j - 1): Exit For
  12.     Next
  13.     k = 1: If Right(A, 1) = "V" Then k = 2
  14.     Jm = xD(T)
  15.     If A = "0" Or xC(A) = 1 Then GoTo 102

  16.    '
  17.     If Jm = 0 Then Arr(k, 1) = Val(Arr(k, 1)) + 1: GoTo 101
  18.     Arr(k, Jm) = Val(Arr(k, Jm)) + 1
  19.     Arr(k, 2) = Val(Arr(k, 2)) + 1
  20. 102:
  21.         xC(A) = 1
  22. 101: Next
  23. [f3].Resize(2, UBound(Arr, 2)) = Arr
  24. End Sub
½Æ»s¥N½X

TOP

Sub ²Î­p¤£ÄÝ©ó¥k°¼()
Dim A, xD, Arr, j&, Jm%, k%, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = [F1:Y2]
For j = 1 To UBound(Arr, 2)
    xD(Arr(1, j)) = j: Arr(1, j) = "": Arr(2, j) = ""
Next j

For Each A In Range([A2], [A1].Cells(Rows.Count, 1).End(xlUp)).Value
    T = Mid(A, 3): If T = "" Or xD(A) = 1 Then GoTo 101
    xD(A) = 1

    For j = 1 To Len(T)
        If Val(Mid(T, j, 1) & 1) Then T = Left(T, j - 1): Exit For
    Next
    k = 1: If Right(A, 1) = "V" Then k = 2
    Jm = xD(T)
    If Jm = 0 Then Arr(k, 1) = Val(Arr(k, 1)) + 1: GoTo 101
    Arr(k, Jm) = Val(Arr(k, Jm)) + 1
    Arr(k, 2) = Val(Arr(k, 2)) + 1
101: Next
[F3].Resize(2, UBound(Arr, 2)) = Arr
End Sub

TOP

¦^´_ 7# ­ã´£³¡ªL


    ·P®¦,¤w§¹¬ü¸Ñ¨M¡I

TOP

        ÀR«ä¦Û¦b : ¤H­n¦Û·R¡A¤~¯à·R´¶¤Ñ¤Uªº¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD