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

[µo°Ý] Excel VBA¿z¿ï³B²z¸ê®Æ¥[³t°ÝÃD

[µo°Ý] Excel VBA¿z¿ï³B²z¸ê®Æ¥[³t°ÝÃD

¦U¦ì¤j¤j¦n¡A¤p§Ì­è¨Ï¥ÎVBA¤£¤[¡A¥Ø«e¥u·|¥´Â²³æªºfunction·f°t¿ý»s¥¨¶°

²{¦b¹J¨ìªº°ÝÃD¬O¡A¥Ø«e¥Î°j°éŪÀÉ¡AµM«á¿z¿ï«á§R°£¤£­nªº¸ê°T
³B²zªº¸ê®Æ¬O¨C¤Ñ720­ÓXMLÀÉ¡A¨C­ÓÀɮ׬ù²ö900µ§ªº¸ê®Æ (¤@¤Ñ¬ù¤»¤Q¸Uµ§¸ê®Æ)
µM¦Ó³B²z«e´X­ÓXMLÀɫܧ֡A¦ý¨ì«á¨Ó´N·|¶V¨Ó¶VºCex¨â¤p®É¥u¶]¤F¬ù540­ÓÀÉ®×

²{¦bªº·Qªk¬O¥i¯à¬OÀHµÛ¸ê®ÆÅܦh¿z¿ï¸ò§R°£ªº³t«×³£·|ÅܺC
©Î³\¥i¥H±N¿z¿ïªºµ²ªG¶K¦Ü·s¤u§@ªí¯à¼W§Ö³t«×¡A¦ý¶K¦Ü·s¤u§@ªí«á¤£ª¾¦p¦ó¦Û°Ê¿ï¨ú¾A·íªº¦ì¸m¶K¤W(¤£­nÂл\²{¦³¸ê®ÆÄ~Äò©¹¤U¶K)

§Æ±æ¦U¦ì¤j¤j­Ì¯àµ¹¤©«ü±Ð»PÀ°§U¡A·P¿E¤£ºÉ¡I

ªþ¤W²{¦bªºVBA code»P¬ÛÃö¸ê®Æ rarÀÉ

Sub test()
    '¶×¤JxmlÀÉ_ÀRºA
    ActiveWorkbook.XmlImport URL:= _
        "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\cms_info_0000.xml", ImportMap:= _
        Nothing, Overwrite:=True, Destination:=Range("$A$1")
    ActiveWorkbook.XmlMaps("XML_Head_Map").Name = "XML_Head_Map_Info"
   
    Sheets("¤u§@ªí2").Select
   '¶×¤JxmlÀÉ_°ÊºA
    ActiveWorkbook.XmlImport URL:= _
        "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\cms_value_0000.xml", ImportMap:= _
        Nothing, Overwrite:=True, Destination:=Range("$A$1")
    '§R°£¤£»ÝÄæ¦ì
    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
   
    With ActiveWorkbook.XmlMaps("XML_Head_Map")
        .ShowImportExportValidationErrors = False
        .AdjustColumnWidth = True
        .PreserveColumnFilter = True
        .PreserveNumberFormatting = True
        .AppendOnImport = True
    End With

    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=ASC([@message])"
    Columns("D:D").ColumnWidth = 41
    Range("ªí®æ2[[#Headers],[Äæ1]]").Select
    ActiveCell.FormulaR1C1 = "¥þ§ÎÂà¥b§Î"
   
    Range("E2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF([@message],""*¾Ã¶ë*"")+COUNTIF([@message],""*K*"")+COUNTIF([@message],""*k*"")+COUNTIF([@message],""*«B*"")+COUNTIF([@message],""*¤Ñ­Ô¤£¨Î*""),1,0)"
    ActiveSheet.ListObjects("ªí®æ2").Range.AutoFilter Field:=5, Criteria1:="0"
    Rows("2:500000").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ListObjects("ªí®æ2").Range.AutoFilter Field:=5
    Range("ªí®æ2[[#Headers],[Äæ1]]").Select
    ActiveCell.FormulaR1C1 = "§tÃöÁä¦r»P§_"
    Columns("F:F").ColumnWidth = 17


        
    sPath = "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\"
    sFile = Dir(sPath & "*.xml")
    'MsgBox (sFile)
    Dim i As Integer
    i = 1
    Do While sFile <> ""
        
        If sFile <> "cms_info_0000.xml" And sFile <> "cms_value_0000.xml" Then
                ActiveWorkbook.XmlMaps("XML_Head_Map").Import URL:= _
            sPath & sFile
            '°ÊºA³B²z
                ActiveSheet.ListObjects("ªí®æ2").Range.AutoFilter Field:=5, Criteria1:="0"
                Rows("2:500000").Select
                Selection.Delete Shift:=xlUp
                ActiveSheet.ListObjects("ªí®æ2").Range.AutoFilter Field:=5

        End If
        sFile = Dir()
        i = i + 1
       Loop
End Sub

   
­ì©l¸ê®Æ³¡¤ÀÀÉ   
CMS.rar (946.55 KB)

  1. Sub ¥¨¶°1()

  2.     ' Timing
  3.     Dim Time0#
  4.     Time0 = Timer
  5.    
  6.     ' Close screenupdating to boost the procedure
  7.     Application.ScreenUpdating = False
  8.    
  9.     ' Import XML data (cms_info)
  10.     ActiveWorkbook.XmlImport URL:= _
  11.         "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\cms_info_0000.xml", ImportMap:= _
  12.         Nothing, Overwrite:=True, Destination:=Range("$A$1")
  13.     ActiveWorkbook.XmlMaps("XML_Head_Map").Name = "XML_Head_Map_Info"
  14.    
  15.     ' Import another XML data (cms_value)
  16.     Sheets("¤u§@ªí2").Select
  17.    
  18.     ActiveWorkbook.XmlImport URL:= _
  19.         "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\cms_value_0000.xml", ImportMap:= _
  20.         Nothing, Overwrite:=True, Destination:=Range("$A$1")
  21.    
  22.     ' Delete unnecessary data
  23.     Columns("A:B").EntireColumn.Delete
  24.     Columns("B:B").EntireColumn.Delete
  25.     Columns("C:C").EntireColumn.Delete

  26.     ' Setting the succeeding import default
  27.     With ActiveWorkbook.XmlMaps("XML_Head_Map")
  28.         .ShowImportExportValidationErrors = False
  29.         .AdjustColumnWidth = True
  30.         .PreserveColumnFilter = True
  31.         .PreserveNumberFormatting = True
  32.         .AppendOnImport = False
  33.     End With

  34.     ' Deal with the string
  35.     [D1].FormulaR1C1 = "¥þ§ÎÂà¥b§Î"
  36.     [D2].FormulaR1C1 = "=ASC([@message])"
  37.     Columns("D:D").ColumnWidth = 41
  38.    
  39.     [E1].FormulaR1C1 = "§tÃöÁä¦r»P§_"
  40.     [E2].FormulaR1C1 = _
  41.         "=IF(COUNTIF([@message],""*¾Ã¶ë*"")+COUNTIF([@message],""*K*"")+COUNTIF([@message],""*k*"")+COUNTIF([@message],""*«B*"")+COUNTIF([@message],""*¤Ñ­Ô¤£¨Î*""),1,0)"
  42.    
  43.     ' Find dest
  44.     'Dim dest&, count&
  45.     Count = 1
  46.     [F2].FormulaR1C1 = "=SUM([§tÃöÁä¦r»P§_])"
  47.     Count = [F2].Value
  48.     Columns("F:F").EntireColumn.Delete
  49.     dest = Count + 1
  50.     'MsgBox (dest)
  51.     ' Filter
  52.     Dim i&, LR&
  53.     'dest = [F1].Value
  54.     'MsgBox (dest)
  55.     Sheets("¤u§@ªí2").ListObjects("ªí®æ2").Range.AutoFilter Field:=5, Criteria1:="1"
  56.     LR = Range("A" & Rows.Count).End(xlUp).Row
  57.     Range("A1:P" & LR).SpecialCells(xlCellTypeVisible).Select
  58.     Selection.Copy
  59.     Sheets("¤u§@ªí3").Range("A1").PasteSpecial xlPasteValues

  60.     Sheets("¤u§@ªí2").ListObjects("ªí®æ2").Range.AutoFilter Field:=5

  61.     sPath = "C:\Users\JM-ASUSCG5285\Desktop\CMS\20150101\"
  62.     sFile = Dir(sPath & "*.xml")
  63.     'MsgBox (sFile)

  64.     i = 1
  65.     Do While sFile <> ""
  66.         If sFile <> "cms_info_0000.xml" And sFile <> "cms_value_0000.xml" Then
  67.                 ActiveWorkbook.XmlMaps("XML_Head_Map").Import URL:= _
  68.             sPath & sFile
  69.             If [A3].Value <> "" Then
  70.             '°ÊºA³B²z
  71.                 [F2].FormulaR1C1 = "=SUM([§tÃöÁä¦r»P§_])"
  72.                 Count = [F2].Value
  73.                 Columns("F:F").EntireColumn.Delete
  74.                 dest = dest + 1
  75.                 Sheets("¤u§@ªí2").ListObjects("ªí®æ2").Range.AutoFilter Field:=5, Criteria1:="1"
  76.                 LR = Range("A" & Rows.Count).End(xlUp).Row
  77.                 Range("A2:P" & LR).SpecialCells(xlCellTypeVisible).Select
  78.                 Selection.Copy
  79.                 Sheets("¤u§@ªí3").Range("A" & dest).PasteSpecial xlPasteValues
  80.                 dest = dest + Count - 1
  81.                 Sheets("¤u§@ªí2").ListObjects("ªí®æ2").Range.AutoFilter Field:=5
  82.             End If
  83.         End If
  84.         sFile = Dir()
  85.         i = i + 1
  86.     Loop
  87.    
  88.     ' Parameterize/ Structure the sheet
  89.     Sheets("¤u§@ªí3").Select
  90.     ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$" & dest), , xlYes).Name = "ªí®æ3"
  91.    
  92.     Application.ScreenUpdating = True
  93.     MsgBox "°õ¦æ®É¶¡ " & Timer - Time0 & " ¬í", vbOKOnly

  94. End Sub
½Æ»s¥N½X
ª¦¤F¤@¨Ç¼W¶i®Ä²vªº¤å«á
Ãö±¼screenupdating¥H¤Î´î¤Öselectionªº¨Ï¥Î
¥[¤W±N¶×¤J¸ê®Æ¿z¿ï·Q­n¸ê®Æ«á¶K¦Ü·sªí®æ¡A¦Ó«D¦b­ìªí®æ¿z¿ï¥X¤£­n¸ê®Æ§R°£
³t«×§Ö¤F«D±`¦h¡A¬ù 1¤À¥b¤º¶]§¹¤@¾ã¤Ñªº¸ê®Æ

¥Ø«e¹J¨ìªº°ÝÃD¬Oselection«áªºvalue·Q¥Îtransfer¦Ó«Dcopy©Mpasteªº¤è¦¡¤£ª¾¹D«ç»ò³B²z
ÁöµM¤£ª¾¹D³t«×·|¦A§Ö¦h¤Ö¡A¦ý¥Ø«eµ²ªGºâ®t±j¤H·N¤F
»P¤j®a¤À¨É¡A­Y¦³«ØijÁٽФ£§[´£¥X¡AÁÂÁ¡I

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2016-11-9 17:20 ½s¿è

¦^´_ 2# wwwlen2002
¥u³B²zcms_value_####.xml
XML_PATH ¦Û¦æ§ï¬°¥¿½T¸ô®|
°Ñ¦Ò :
  1. Sub Test()
  2.     Dim t: t = Timer
  3.    
  4.     Const XML_PATH = "C:\Users\xxxxx\Downloads\CMS\CMS\20150101"
  5.     Dim oXml As Object: Set oXml = CreateObject("msxml2.domdocument")   
  6.     Dim sFile As String, sTime As String, sCmsid As String, sMessage As String
  7.     Dim oNodes As Object, arData, cnt As Long
  8.     ReDim arData(1 To 3, 1 To 1)
  9.     sFile = Dir(XML_PATH & "\")
  10.     Do While Len(sFile) > 0
  11.         If sFile Like "cms_value_####.xml" Then
  12.             oXml.Load XML_PATH & "\" & sFile
  13.             With oXml.ChildNodes(1)
  14.                 sTime = .getAttribute("updatetime")
  15.                 Set oNodes = .getElementsbyTagName("Info")
  16.                 ReDim Preserve arData(1 To 3, 1 To UBound(arData, 2) + oNodes.Length)
  17.                 For Each x In oNodes
  18.                     sMessage = WorksheetFunction.Asc(x.getAttribute("message"))   '¥þ§ÎÂà¥b§Î
  19.                     If HasMyKeyWords(sMessage) Then
  20.                         sCmsid = x.getAttribute("cmsid")
  21.                         cnt = cnt + 1
  22.                         arData(1, cnt) = sTime
  23.                         arData(2, cnt) = sCmsid
  24.                         arData(3, cnt) = sMessage
  25.                     End If
  26.                 Next
  27.                 ReDim Preserve arData(1 To 3, 1 To cnt)
  28.             End With
  29.         End If
  30.         sFile = Dir()
  31.     Loop   
  32.    
  33.     If cnt > 0 Then
  34.         With Sheets.Add(After:=Sheets(Sheets.Count))
  35.             .[a1].Resize(1, 3) = Array("updatetime", "cmsid", "message")
  36.             .[a2].Resize(cnt, 3) = Application.Transpose(arData)
  37.             .UsedRange.Columns.AutoFit
  38.         End With
  39.     End If
  40.    
  41.     MsgBox "°õ¦æ®É¶¡ " & Timer - t & " ¬í", vbOKOnly
  42. End Sub

  43. Function HasMyKeyWords(s As String) As Boolean
  44.     For Each x In Array("¾Ã¶ë", "K", "k", "«B", "¤Ñ­Ô¤£¨Î")
  45.         If InStr(1, s, x) > 0 Then
  46.             HasMyKeyWords = True
  47.             Exit Function
  48.         End If
  49.     Next
  50.     HasMyKeyWords = False
  51. End Function
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

        ÀR«ä¦Û¦b : ¬°¦Û¤v§äÂǤfªº¤H¥Ã»·¤£·|¶i¨B¡C
ªð¦^¦Cªí ¤W¤@¥DÃD