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

½Ð°Ý¦p¦ó±Nªí®æªº¸ê°T¾ã²z¦¨§Ú­nªº¸ê°T

½Ð°Ý¦p¦ó±Nªí®æªº¸ê°T¾ã²z¦¨§Ú­nªº¸ê°T

½Ð°Ý§Ú¦³¤@­Óªí®æ¦p¤U­±²Ä¤@±i¹Ï
§Ú·Q¦b¿é¤J§¹sheet1ªºªí®æ«á
¦bsheet2¶]¥Xsheet1¦³­Èªº¸ê°T¦p²Ä¤G±i¹Ï
¬O¤£¬O±o¥ÎVBA¼g¤~¦æ?
¦Ó¥BÁÙ­n¦³¦rÅéÃC¦â¡AÀ³¸Ó¤£¯à¥Î¨ç¼Æª½±µ¼g§a?
·Ð½Ð¦U¦ì¤j¤j«üÂI



Form.rar (2.32 KB)
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

¦^´_ 1# amu1129
  1. Sub Ex()
  2.     Dim Ar(), E As Range, Msg$, i%, y%, C%
  3.     Ar = Array("a2", "g2", "a8", "g8")
  4.     C = 4
  5.     For i = 1 To Sheet1.[C2:F11].Columns.Count
  6.         Msg = ""
  7.         y = 0
  8.         For Each E In [C2:F11].Columns(i).Cells
  9.             If E <> "" Then
  10.                 Msg = IIf(Msg <> "", Msg & Chr(10), "") & "¦b" & Cells(E.Row, 1) & "©±¶R¤F" & Cells(E.Row, 2) & E & "ªK"
  11.                 y = y + 1
  12.             End If
  13.         Next
  14.         Sheet2.Range(Ar(i - 1)) = IIf(Msg <> "", Msg & Application.Rept(Chr(10), IIf(y < C, C - y, 0)) & IIf(y < C, "¥H¤W", ""), "")
  15.     Next
  16. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# GBKEE
¶]¥X¨Ó¤F ÁÂÁª©¥D
¦ý§Ú·Q¦Aµy§@­×§ï ¹³¤U¹Ï

§Ú¤gªk·Ò¿û§ï¦¨¥H¤U³o¼Ë
¦ý¬O¦n¹³¤£¹ï
§ÚÁÙ·Q½Ð°Ý¦V¤¤¶¡¨S¼Æ­Èªº¸Ü
·|¦³ªÅ¥Õ¦C ¥i¥H¤£­n¦³ªÅ¥Õ¶Ü
¦pªG­n­×§ï¦r«¬ªº¸Ü ­n©ñ¦b°j°é¤ºÁÙ¬O°j°é¥~
·Ð½Ðª©¥D¬°¤p§Ì¸Ñ´b¤@¤U

Sub Ex()
    Dim Ar(), E As Range, Msg$, i%, y%, C%
    Ar = Array("a2", "g2", "a8", "g8")
    C = 4
    For i = 1 To Sheet1.[C2:F6].Columns.Count
        Msg = ""
        y = 0
        For Each E In [C2:F6].Columns(i).Cells
            If E <> "" Then
                Msg = IIf(Msg <> "", Msg & Chr(10), "") & "¦b" & Cells(E.Row, 1) & "©±¶R¤F" & Cells(E.Row, 2) & E & "ªK"

                y = y + 1
            End If
        Next
        Sheet2.Range(Ar(i - 1)) = IIf(Msg <> "", Msg & Application.Rept(Chr(10), IIf(y < C, C - y, 0)) & IIf(y < C, "½Ð¦ÜA©±¨ú³f", ""), "")
    Next
    For i = 1 To Sheet1.[C7:F11].Columns.Count
        Msg = ""
        y = 0
        For Each E In [C7:F11].Columns(i).Cells
            If E <> "" Then
                Msg = IIf(Msg <> "", Msg & Chr(10), "") & "¦b" & Cells(E.Row, 1) & "©±¶R¤F" & Cells(E.Row, 2) & E & "ªK"

                y = y + 1
            End If
        Next
        Sheet2.Range(Ar(i - 1)) = IIf(Msg <> "", Msg & Application.Rept(Chr(10), IIf(y < C, C - y, 0)) & IIf(y < C, "½Ð¦ÜB©±¨ú³f", ""), "")
    Next
End Sub
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 3# amu1129
  1. Sub Ex()
  2.     Dim Ar(), E, Msg$, i%, y%, C%, MsgAr
  3.     Ar = Array("a2", "g2", "a8", "g8")
  4.     C = 4
  5.     With Sheet1
  6.         For i = 1 To .[C2:F11].Columns.Count
  7.             Msg = ""
  8.             y = 0
  9.             For Each E In .[C2:F11].Columns(i).Cells
  10.                 If E <> "" Then
  11.                     Msg = IIf(Msg <> "", Msg & Chr(10), "") & "¦b" & .Cells(E.Row, 1) & "©±¶R¤F" & .Cells(E.Row, 2) & E & "ªK"
  12.                     y = y + 1
  13.                 End If
  14.             Next
  15.             Sheet2.Range(Ar(i - 1)) = Msg
  16.         Next
  17.     End With
  18.     With Sheet2
  19.         For Each E In Ar      ''''' ¥[¤J¤å¦r
  20.             MsgAr = Split(.Range(E), Chr(10))
  21.             If UBound(MsgAr) >= 1 Then
  22.                 For i = 0 To UBound(MsgAr)
  23.                     If i < UBound(MsgAr) Then
  24.                         y = InStr(MsgAr(i), "©±")
  25.                         If Mid(MsgAr(i), 1, y) <> Mid(MsgAr(i + 1), 1, y) Then
  26.                             MsgAr(i) = MsgAr(i) & Chr(10) & "½Ð¦Ü" & Mid(MsgAr(i), 2, y - 1) & "¨ú³f"
  27.                         End If
  28.                     End If
  29.                 Next
  30.             End If
  31.             If UBound(MsgAr) > -1 Then
  32.                 y = InStr(MsgAr(UBound(MsgAr)), "©±")
  33.                 MsgAr(UBound(MsgAr)) = MsgAr(UBound(MsgAr)) & Chr(10) & "½Ð¦Ü" & Mid(MsgAr(UBound(MsgAr)), 2, y - 1) & "¨ú³f" & Chr(10) & "¥H¤W"
  34.                 .Range(E) = Join(MsgAr, Chr(10))
  35.             End If
  36.         Next
  37.         For Each E In Ar        ''''' ³B²zÃC¦â
  38.             MsgAr = Split(.Range(E), Chr(10))
  39.             .Range(E).Font.ColorIndex = 3
  40.             C = 1
  41.             For i = 0 To UBound(MsgAr)
  42.                 If InStr(MsgAr(i), "¦b") > 0 Then
  43.                     y = InStr(MsgAr(i), "©±")
  44.                 Else
  45.                     y = 0
  46.                 End If
  47.                 If y > 0 Then .Range(E).Characters(Start:=C, Length:=y).Font.ColorIndex = 10
  48.                 C = C + Len(MsgAr(i)) + 1
  49.             Next
  50.         Next
  51.     End With
  52. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# GBKEE

¤£¦n·N«ä~ª©¥D
§Ú«ç»ò§ï¤@¤U®æ¦¡´N¶]¤£¥X¨Ó¤F
§Ú·QÅý¹Ï¤@Åܦ¨¹Ï¤G¨º¼Ë
¥t¥~¦A¥[¤@­Ó«ö¶s¦b¤U­±Åý¦¹¥¨¶°¦Û°Ê°Ê§@(¹Ï¤T¬õ¦â³B)
³Â·Ðª©¥D¤j¤H¤F



Test.rar (10.16 KB)
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 5# amu1129
  1. With Sheet2
  2.         For Each E In Ar      ''''' ¥[¤J¤å¦r
  3.             MsgAr = Split(.Range(E), Chr(10))
  4.             If UBound(MsgAr) >= 1 Then
  5.                 For i = 0 To UBound(MsgAr)
  6.                     If i < UBound(MsgAr) Then
  7.                         y = InStr(MsgAr(i), "¦Ü")
  8.                         yy = InStr(MsgAr(i + 1), "¦Ü")
  9.                         If Mid(MsgAr(i), y, 8) <> Mid(MsgAr(i + 1), yy, 8) Then
  10.                             yy = InStr(MsgAr(i), "(¤p¥]¸Ë)")
  11.                              Store = Mid(MsgAr(i), y + 1, yy - y - 2)
  12.                             MsgAr(i) = MsgAr(i) & Chr(10) & "½Ð¦Ü" & Store & "¨ú³f(¤À¾÷:123 ³sµ¸)"
  13.                         End If
  14.                     End If
  15.                 Next
  16.             End If
  17.             If UBound(MsgAr) > -1 Then
  18.                 i = UBound(MsgAr)
  19.                 y = InStr(MsgAr(i), "¦Ü")
  20.                 yy = InStr(MsgAr(i), "(¤p¥]¸Ë)")
  21.                 Store = Mid(MsgAr(i), y + 1, yy - y - 2)
  22.                 MsgAr(i) = MsgAr(i) & Chr(10) & "½Ð¦Ü" & Store & "¨ú³f(¤À¾÷:223 ³sµ¸)" & Chr(10) & Chr(10) & "½Ð³t¦Ü»â¨ú" & Chr(10) & "**½Ð©ó»â¨ú«á§iª¾"
  23.                 .Range(E) = Join(MsgAr, Chr(10))
  24.             End If
  25.         Next
  26.         For Each E In Ar        ''''' ³B²zÃC¦â
  27.             MsgAr = Split(.Range(E), Chr(10))
  28.             .Range(E).Font.ColorIndex = 3
  29.             C = 1
  30.             For i = 0 To UBound(MsgAr)
  31.                 y = InStr(MsgAr(i), "°e¦Ü")
  32.                 If y > 0 Then .Range(E).Characters(Start:=C, Length:=y + 1).Font.ColorIndex = 10
  33.                 If InStr(MsgAr(i), "¤À¾÷") > 0 Then .Range(E).Characters(Start:=C, Length:=Len(MsgAr(i))).Font.ColorIndex = 9
  34.                 C = C + Len(MsgAr(i)) + 1
  35.             Next
  36.         Next
  37.     End With
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : Ãø¦æ¯à¦æ¡AÃø±Ë¯à±Ë¡AÃø¬°¯à¬°¡A¤~¯àª@µØ¦Û§Úªº¤H®æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD