[已解决]多了几列空列

张雄友

grf1973 发表于 2015-4-6 20:38
maxc没定义，初始值就是0.只要计算出一个c,就会变成c，然后跟每一个计算出的c比较，取其大值。

成功了，但是有二个问题：

一，arr = sh.[A1].Resize(r, Application.Max(c1, c2)) '定义数组！这里为什么用A1？而不是用 Rng1 ？？？

二，当文件名的数字很大时，如： 车间567000，（当然这只是一个车间的编码），567000大于最大列标了，所以行不通。

grf1973

因为用到了rng1.column之类的，这是相对于第1列而言的。如果用相对值可以是可以，但要多个换算过程，比较麻烦。

张雄友

grf1973 发表于 2015-4-6 21:02
因为用到了rng1.column之类的，这是相对于第1列而言的。如果用相对值可以是可以，但要多个换算过程，比较麻 ...

您的意思是否是说：

一，arr = sh.[A1].Resize(r, Application.Max(c1, c2)) '定义数组！这里可以用A1，或者 A2，B2，但不能用rng1 之类的？？

张雄友

grf1973 发表于 2015-4-6 21:02
因为用到了rng1.column之类的，这是相对于第1列而言的。如果用相对值可以是可以，但要多个换算过程，比较麻 ...

不是的，用 B2，试了，不行的。可能只能只最左上角的值，A1。

grf1973

先排序，再输出。

1. Sub 比较()
   
2.     [B1:IV65536].ClearContents
   
3.     Dim fd As FileDialog, wb As Workbook, sh As Worksheet, Mypath As String, arrf$(), mf&
   
4.      With Application.FileDialog(msoFileDialogFolderPicker)
   
5.         .AllowMultiSelect = False
   
6.         If .Show = -1 Then
   
7.             Mypath = .SelectedItems(1)
   
8.             If Right(Mypath, 1) <> "" Then Mypath = Mypath & ""
   
9.         Else
   
10.             If MsgBox("以本工作簿所在路径为默认文件夹吗？" _
    
11.                     & vbNewLine & vbNewLine & "单击“否”可退出程序", vbYesNo, "确认默认路径") = vbYes Then
    
12.                 Mypath = ThisWorkbook.Path
    
13.                 If Right(Mypath, 1) <> "" Then Mypath = Mypath & ""
    
14.             Else
    
15.                 GoTo The_Exit
    
16.             End If
    
17.         End If
    
18.     End With
    
19.     Application.ScreenUpdating = False
    
20.     If Mypath <> "" Then  '如果选到
    
21.    
    
22.         Call GetFiles(Mypath, arrf, mf)
    
23.         Set d = CreateObject("scripting.dictionary")        'arrf内排序
    
24.         For k = 1 To UBound(arrf)   '读取月份，存入字典
    
25.             F = arrf(k)
    
26.             If InStr(F, ThisWorkbook.Name) = 0 Then
    
27.                 yf = Val(Split(F, "")(UBound(Split(F, ""))))
    
28.                 d(F) = yf
    
29.             End If
    
30.         Next
    
31.         For k = 1 To UBound(arrf) - 1 '双循环比较，排序
    
32.             For k1 = k + 1 To UBound(arrf)
    
33.                 F = arrf(k): F1 = arrf(k1)
    
34.                 If InStr(F, ThisWorkbook.Name) = 0 And InStr(F1, ThisWorkbook.Name) = 0 Then
    
35.                     If d(F) > d(F1) Then
    
36.                         tmp = arrf(k): arrf(k) = arrf(k1): arrf(k1) = tmp
    
37.                     End If
    
38.                 End If
    
39.             Next
    
40.         Next
    
41.         
    
42.         c = 1
    
43.         xrr = Sheets("get").Range("A1:A" & Sheets("get").[A65536].End(3).Row)     '当前工作A列数据
    
44.         For Each F In arrf     '打开所有文件（已排序）
    
45.             If InStr(F, ThisWorkbook.Name) = 0 Then
    
46.                 Set wb = Workbooks.Open(F)
    
47.                     For Each sh In wb.Worksheets
    
48.                         If Application.WorksheetFunction.CountA(sh.UsedRange) Then
    
49.                             xname = Split(wb.Name, ".")(0)   '工作表名
    
50.                             Set d = CreateObject("scripting.dictionary")
    
51.                             'arr = sh.[a1].CurrentRegion
    
52.                            ' arr = sh.UsedRange
    
53.                         Set rng1 = sh.UsedRange.Find("车间")
    
54.                         Set Rng2 = sh.UsedRange.Find("产量")
    
55.                         If Not rng1 Is Nothing And Not Rng2 Is Nothing Then
    
56.                         c1 = rng1.Column
    
57.                         c2 = Rng2.Column
    
58.                         r = sh.Cells(Rows.Count, c2).End(3).Row '产量列的最大行
    
59.                         arr = sh.[A1].Resize(r, Application.Max(c1, c2)) '定义数组！
    
60. 
    
61.                             For i = rng1.Row + 1 To UBound(arr)      '打开工作表A列和B列相关联
    
62.                                d(arr(i, 1)) = arr(i, c2)
    
63.                             Next
    
64.                         End If
    
65.                         End If
    
66.                     Next
    
67.                 wb.Close False
    
68.                 ReDim yrr(1 To UBound(xrr), 1 To 1): yrr(1, 1) = xname
    
69.                 For i = 2 To UBound(xrr)
    
70.                    yrr(i, 1) = d(xrr(i, 1))
    
71.                 Next
    
72.                 c = c + 1
    
73. '                c = getNum(xname) + 1 ''''''''''''''''''''''''''根据月份得到列号
    
74. '                 maxc = IIf(c > maxc, c, maxc)
    
75.                 Sheets("get").Cells(1, c).Resize(UBound(yrr), 1) = yrr
    
76.                 d.RemoveAll
    
77.             End If
    
78.        Next
    
79.     End If
    
80. '    With Sheets("get")      '判断空列并删除
    
81. '        For j = maxc To 2 Step -1
    
82. '            If Application.WorksheetFunction.CountA(.Columns(j)) = 0 Then .Columns(j).Delete
    
83. '        Next
    
84. '    End With
    
85. The_Exit:
    
86. Application.ScreenUpdating = True
    
87. End Sub

复制代码

grf1973

因为在代码中定义rng1时用了绝对地址，而绝对地址是相对于[a1]的，所以只能以[a1]起算！

张雄友

grf1973 发表于 2015-4-6 21:20
先排序，再输出。

附件黄色单元格排序不对。

grf1973

用了个子函数获取年月日。

1. Function GetLastNum(x)       '获取字符串最后几位数值
   
2.     If Len(x) = 0 Then
   
3.         GetLastNum = 0
   
4.     Else
   
5.         For j = Len(x) To 1 Step -1
   
6.             If Not IsNumeric(Mid(x, j, 1)) Then Exit For
   
7.         Next
   
8.         If j = Len(x) Then GetLastNum = 0 Else GetLastNum = Val(Mid(x, j + 1))
   
9.     End If
   
10. End Function

复制代码

张雄友

grf1973 发表于 2015-4-7 13:19
用了个子函数获取年月日。

日常工作中，往往为了方便把日期写成：日期是带点数字。就不行了！

grf1973