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

[µo°Ý] ¦p¦ó±N¯S©w´X¦æ¤º®eÂনÄæ¦ì­«½Æ

[µo°Ý] ¦p¦ó±N¯S©w´X¦æ¤º®eÂনÄæ¦ì­«½Æ

§Ú¦³¤@­Ó¯Â¤å¦rÀÉ¡AÀɮ׮榡¦p¤U¹Ï

½Ð°Ý§Ú­n¦p¦ó¼gVBAµ{¦¡¡A¥i¥H§â¼Ð·Ç§O¨º¤@¦æ¡AÂন³æÄæÀx¦s¡C
®æ¦¡¦p¤U

¦]¬°¤ÀÃþ¤Ó¦h¡A§Æ±æ¯à¼gVBAµ{¦¡À°¦£¸Ñ¨M

Àɮ׳sµ²¦p¤U
date.zip (648 Bytes)

Sub ¶×¤J()
Dim xFile$, TxtStr$, T$, TR, Arr, i&, N&
Intersect(ActiveSheet.UsedRange, [A:G]).Offset(1, 0).EntireRow.Delete
xFile = ThisWorkbook.Path & "\date.txt"
With CreateObject("ADODB.Stream")
     .Charset = "UTF-8"
     .Open
     .LoadFromFile xFile
      TxtStr = .ReadText
      .Close
End With
TR = Split(TxtStr, vbCrLf)
ReDim Arr(1 To UBound(TR), 1 To 7)
For i = 0 To UBound(TR)
    If Len(TR(i)) < 2 Then GoTo 101
    If Left(TR(i), 6) = "¼Ð ·Ç §O¡G" Then T = Mid(TR(i), 7): GoTo 101
    If T = "" Then GoTo 101
    N = N + 1
    Arr(N, 1) = T '¼Ð·Ç§O
    Arr(N, 2) = Trim(Evaluate("MidB(""" & TR(i) & """, 1, 10)")) '³B¸m¥N½X
    Arr(N, 3) = Trim(Evaluate("MidB(""" & TR(i) & """, 11, 30)")) '³B¸m¦WºÙ
    Arr(N, 4) = Trim(Evaluate("MidB(""" & TR(i) & """, 41, 10)")) '¦¨¥»¤¤¤ß
    Arr(N, 5) = Trim(Evaluate("MidB(""" & TR(i) & """, 51, 10)")) '³B¸mÃþ§O
    Arr(N, 6) = Trim(Evaluate("MidB(""" & TR(i) & """, 61, 10)")) '°·«O³æ»ù
    Arr(N, 7) = Trim(Evaluate("MidB(""" & TR(i) & """, 71, 10)")) '¦Û¶O³æ»ù
101: Next i
If N > 0 Then [A2].Resize(N, 7) = Arr
End Sub

´ú¸ÕÀÉ:
¤å¦rÀÉÂàExcel.rar (11.77 KB)



======================================

TOP

¦^´_ 2# ­ã´£³¡ªL
«Ü·PÁ±zÀ°¦£§Ú¸Ñ¨M°ÝÃD¡A¦ý¬O§Úªº¸ê®Æµ§¼Æ«Ü¦h¡A¤§«e©ñ¦bºô¸ôªºÀɮ׬Oºë²ª©¡A¹ê»Ú¤W§Ú¦³ªñ3000µ§¸ê®Æ­nÂà´«
§Úµo²{§ÚµLªk¥Î¸Óµ{¦¡½XÂà´«ªñ3000µ§¸ê®Æ¡AVBA¤@ª½¥X²{¦p¤U¹Ï¿ù»~°T®§


§Ú¬Ý¤£¥X¨Ó­n«ç¼Ë­×¥¿µ{¦¡½X¤~¯à¥¿½T¶×¤J
­«·sªþ¤W·sªºÀɮסA¸Ì­±¦³300µ§¸ê°T
data2.zip (6.77 KB)

TOP

¦^´_ 2# ­ã´£³¡ªL
«Ü·PÁ±zÀ°¦£§Ú¸Ñ¨M°ÝÃD¡A¦ý¬O§Úªº¸ê®Æµ§¼Æ«Ü¦h¡A¤§«e©ñ¦bºô¸ôªºÀɮ׬Oºë²ª©¡A¹ê»Ú¤W§Ú¦³ªñ3000µ§¸ê®Æ­nÂà´«
§Úµo²{§ÚµLªk¥Î¸Óµ{¦¡½XÂà´«ªñ3000µ§¸ê®Æ¡AVBA¤@ª½¥X²{¦p¤U¹Ï¿ù»~°T®§
[attach]31732[/attach]

§Ú¬Ý¤£¥X¨Ó­n«ç¼Ë­×¥¿µ{¦¡½X¤~¯à¥¿½T¶×¤J
­«·sªþ¤W·sªºÀɮסA¸Ì­±¦³300µ§¸ê°T
[attach]31733[/attach]

TOP

¦^´_ 3# ¦¶¤l
Sub ¶×¤J()
Dim xFile$, TxtStr$, T$, TR, Arr, i&, N&
Intersect(ActiveSheet.UsedRange, [A:G]).Offset(1, 0).EntireRow.Delete
xFile = ThisWorkbook.Path & "\data2.txt"
With CreateObject("ADODB.Stream")
     .Charset = "UTF-8"
     .Open
     .LoadFromFile xFile
      TxtStr = .ReadText
      .Close
End With
TR = Split(TxtStr, vbCrLf)
ReDim Arr(1 To UBound(TR), 1 To 7)
For i = 0 To UBound(TR)
    If Len(TR(i)) < 2 Then GoTo 101
    If Left(TR(i), 6) = "¼Ð ·Ç §O¡G" Then T = Mid(TR(i), 7): GoTo 101
    If T = "" Then GoTo 101
    N = N + 1
    TR(i) = Replace(TR(i), """", "|")
    Arr(N, 1) = T '¼Ð·Ç§O
    Arr(N, 2) = Trim(Evaluate("MidB(""" & TR(i) & """, 1, 10)")) '³B¸m¥N½X
    Arr(N, 3) = Replace(Trim(Evaluate("MidB(""" & TR(i) & """, 11, 30)")), "|", """") '³B¸m¦WºÙ
    Arr(N, 4) = Trim(Evaluate("MidB(""" & TR(i) & """, 41, 10)")) '¦¨¥»¤¤¤ß
    Arr(N, 5) = Trim(Evaluate("MidB(""" & TR(i) & """, 51, 10)")) '³B¸mÃþ§O
    Arr(N, 6) = Trim(Evaluate("MidB(""" & TR(i) & """, 61, 10)")) '°·«O³æ»ù
    Arr(N, 7) = Trim(Evaluate("MidB(""" & TR(i) & """, 71, 10)")) '¦Û¶O³æ»ù
101: Next i
If N > 0 Then [A2].Resize(N, 7) = Arr
End Sub


'===============================

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD