1、vba对xml文件解析Sub delete() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim ItemVal As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileNam
2、e As String, LineOut As String Dim DateString As String Dim DateStringF As String Dim tmpStr As String Dim s_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 取报表日期 TabDate = CDate(Left(Worksheets(Sheet1).Cells(2, 4).Value, 11) DateString = Format(TabDate, yyyy-mm-dd) DateStringF =
3、Format(TabDate, yyyymmdd) On Error Resume Next On Error GoTo 0 = 正在预备网调日报数据,请稍候. FileName = Dim MisFileName As String MisFileName = HDRB_MISPath & 福建 & DateStringF & .FD288 Open FileName For Output As #1 tmpStr = D288 Print #1, tmpStr Print #1, tmpStr = Print #1, tmpStr LineMaxCharNum ItemCode = 数据名
4、称 ItemVal = 数据值 tmpStr = ItemCode & Space(1) & ItemVal Print #1, tmpStr For i = 0 To theRowCount theRow = theRowS + i theCol = theColS Worksheets(sheet1).Cells(theRow, theCol).Select Worksheets(Sheet1).Cells(field2(k), field3(k).Value ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value If InSt
5、r(ItemCode, ) 0 Or InStr(ItemCode, ) 0 Or InStr(ItemCode, ) 0 Then delete If InStr(ItemCode, ) 0 Then Worksheets(sheet1).Rows(theRow).delete i = i - 1 End If If InStr(ItemCode, ) 0 Then Worksheets(sheet1).Rows(theRow).delete i = i - 1 End If 解析公式 If InStr(ItemCode, ) Then s_num = InStr(ItemCode, ) I
6、temCode = Mid(ItemCode, s_num + 20) ItemCode = RTrim(ItemCode) lengthall = Len(ItemCode) ItemCode = Mid(ItemCode, 1, lengthall - 21) Worksheets(Sheet1).Cells(theRow, theCol).Value = ItemCode End If Print #1, tmpStr Next i 文件终止 tmpStr = Print #1, tmpStr Close #1 End SubSub id() Dim i As Long Dim nSpa
7、ce As Long Dim ItemCode As String 代码 Dim ItemVal As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, LineOut As String Dim DateString
8、As String Dim DateStringF As String Dim tmpStr As String Dim s_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value 解析id If InStr(ItemCode, P:) 0 Then s_num = InStr(
9、ItemCode, P:) ItemCode = Mid(ItemCode, s_num + 2) ItemCode = RTrim(ItemCode) lengthall = Len(ItemCode) ItemCode = Mid(ItemCode, 1, lengthall - 2) Worksheets(Sheet1).Cells(theRow, theCol).Value = ItemCode End If Next iEnd SubSub chinese() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim
10、 ItemVal As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, LineOut As String Dim DateString As String Dim DateStringF As String Dim
11、tmpStr As String Dim s_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value 解析中文 If InStr(ItemCode, ) 0 Then s_num = InStr(ItemCode, ) ItemCode = Mid(ItemCode, s_num
12、 + 17) ItemCode = RTrim(ItemCode) lengthall = Len(ItemCode) If InStr(ItemCode, ) 0 Then ItemCode = Mid(ItemCode, 1, lengthall - 18) End If Worksheets(Sheet1).Cells(theRow, theCol).Value = ItemCode End If Next iEnd SubSub formular() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim ItemV
13、al As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, LineOut As String Dim DateString As String Dim DateStringF As String Dim tmpStr
14、 As String Dim s_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value 解析公式 If InStr(ItemCode, ) Then s_num = InStr(ItemCode, ) ItemCode = Mid(ItemCode, s_num + 20) I
15、temCode = RTrim(ItemCode) lengthall = Len(ItemCode) ItemCode = Mid(ItemCode, 1, lengthall - 21) Worksheets(Sheet1).Cells(theRow, theCol).Value = ItemCode End If Next iEnd SubSub zhuanzhi() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim ItemVal As String 数值 Dim TabDate As Date Dim the
16、RowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, LineOut As String Dim DateString As String Dim DateStringF As String Dim tmpStr As String Dim s_num As Integer Dim id_num
17、As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 id_num = 0 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value 解析公式 If InStr(ItemCode, ) 0 Then id_num = id_num + 1 Worksheets(Sheet1).Cells(theRow + 1, 2).Value = id_n
18、um Worksheets(Sheet1).Cells(theRow + 1, 3).Value = Worksheets(Sheet1).Cells(theRow + 2, 1).Value Worksheets(Sheet1).Cells(theRow + 2, 1).Value = aaaaaa Worksheets(Sheet1).Cells(theRow + 1, 4).Value = Worksheets(Sheet1).Cells(theRow + 3, 1).Value Worksheets(Sheet1).Cells(theRow + 3, 1).Value = bbbbbb
19、 For j = 1 To 50 If InStr(Worksheets(Sheet1).Cells(theRow + 3 + j, 1).Value, ) = 0 Then Worksheets(Sheet1).Cells(theRow + 1, 4 + j).Value = Worksheets(Sheet1).Cells(theRow + 3 + j, 1).Value Worksheets(Sheet1).Cells(theRow + 3 + j, 1).Value = cccccc Else Exit For End If Next j End If Next iEnd SubSub
20、 finish() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim ItemVal As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim theRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, L
21、ineOut As String Dim DateString As String Dim DateStringF As String Dim tmpStr As String Dim s_num As Integer Dim id_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 id_num = 0 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow
22、, theCol).Value 解析公式 If InStr(ItemCode, ) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If If InStr(ItemCode, aaaaaa) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If If InStr(ItemCode, bbbbbb) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If If InStr(ItemCo
23、de, cccccc) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If Next iEnd SubSub delete_new() Dim i As Long Dim nSpace As Long Dim ItemCode As String 代码 Dim ItemVal As String 数值 Dim TabDate As Date Dim theRowCount As Long 有效报表列 Dim theRowS As Long 开始数据所在行 Dim theColS As Long 开始数据所在列 Dim t
24、heRow As Long 数据所在行 Dim theCol As Long 数据所在列 Dim DataNum As Long 数据个数 Dim FileName As String, LineOut As String Dim DateString As String Dim DateStringF As String Dim tmpStr As String Dim s_num As Integer Dim id_num As Integer dfile = theRowCount = 65000 theRowS = 1 theColS = 1 id_num = 0 For i = 0 To theRowCount theRow = theRowS + i theCol = theColS ItemCode = Worksheets(Sheet1).Cells(theRow, theCol).Value If InStr(ItemCode, ) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If If InStr(ItemCode, ) 0 Then Worksheets(Sheet1).Rows(theRow).delete i = i - 1 End If Next iEnd Sub
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1