楼主
kevinchengcw |
本例引用一个合并了数据行的数据区，依据数据特征将其还原成数据表，代码如下：- Sub test()
- Dim M, N, I, T As Long
- Dim Arr, Arr2, Arr3
- Dim Str, BB As String
- Application.ScreenUpdating = False '关闭屏幕刷新
- For M = Cells(Rows.Count, 1).End(3).Row To 2 Step -1 '因为要删除无意义的行，所以我们从后向前来
- Str = "" '处理每行前清空用于记录公司名的字符串变量
- BB = "" '清空用于记录币种的变量
- Cells(M, 1) = WorksheetFunction.Trim(Cells(M, 1)) '将单元格内容用工作表函数去除多余空格
- If Len(Cells(M, 1).Value) < 20 Or Cells(M, 1) = "" Or InStr(Cells(M, 1).Value, "小計") > 0 Or InStr(Cells(M, 1).Value, "欠") > 0 Or InStr(Cells(M, 1).Value, "天") > 0 Or InStr(Cells(M, 1).Value, "Total") > 0 Then
- Rows(M).Delete '根据特征字符删除无意义行
- Else '如果没有特征字符的行则进行正常处理
- If InStr(Cells(M, 1).Value, "USD") > 0 Then BB = " USD " '判断并记录币种
- If InStr(Cells(M, 1).Value, "EUR") > 0 Then BB = " EUR "
- If InStr(Cells(M, 1).Value, "RMB") > 0 Then BB = " RMB "
- Arr = Split(Cells(M, 1).Value, BB) '以币种为分隔符分隔成前后两个段放入数组，主要因为币种的列固定，而前面的列不固定
- Arr2 = Split(Arr(0), " ") '前面的数据段依空格分割放入数组2
- Arr3 = Split(Arr(1), " ") '后面的数据段依空格分割放入数组3
- I = 2 '设定前面段写入数据的起始列号值，不设成1是因为有些行没有公司名，而公司名要放到A列里
- For N = LBound(Arr2) To UBound(Arr2) '循环前段数据区的数组各个值
- If Not (IsNumeric(Right(Arr2(N), 1)) Or IsNumeric(Left(Arr2(N), 1))) Then '如果数组当前值和第一位和最后一位都不是数字（非傳票號碼，客戶PO/NO，訂單號的特征）
- Do While Not (IsNumeric(Right(Arr2(N), 1)) Or IsNumeric(Left(Arr2(N), 1))) '一直循环到是为止
- Str = Str & " " & Arr2(N) '循环中不停将不是的值用空格分隔串接给变量str（这个就是公司名了）
- N = N + 1 'N值递增
- Loop
- End If
- Cells(M, I) = Arr2(N) '将符合条件的数组值写入对应单元格
- I = I + 1 '写好后移到下一列
- Next N
- Cells(M, 1) = Str '第一个单元格的值等于公司名字串记录到的内容（可能是空值）
- Cells(M, 5) = Trim(BB) '固定的币种列里写入记录的当前行的币种
- I = 6 '重新设定后面数据段的起始写入列值
- For N = LBound(Arr3) To UBound(Arr3) '循环后一个数据段的内容
- Cells(M, I) = Arr3(N) '写入对应单元格
- I = I + 1 '后移一列
- Next N
- End If
- Next M
- '设定标题行的数据内容
- Arr = Split("客戶,傳票號碼,客戶PO/NO,訂單號,幣別,未逾期欠款,逾期30天以內,31--60天,61--90天,91--180天,181天--1年,1年以上--2年,2年以上,欠款總額(原幣),欠款總額(原幣),**日,預計入款日", ",")
- For N = LBound(Arr) To UBound(Arr) '循环写入标题行内容并自动适应列宽
- Cells(1, N + 1) = Arr(N)
- Cells(1, N + 1).EntireColumn.AutoFit
- Next N
- Application.ScreenUpdating = True '打开屏幕显示
- End Sub
公司名称无法完全还原是个遗憾，如果您有好的思路可于下方回复留言，如果切实可行我会加分。
 帳齡分析表1_.rar
|