一个大神的代码，想改造成加载项，出现数据格式错误，请高手帮忙

lhteee

一个合并表格的VBA，很好用，想改造成加载项使用，但出现以下问题，就是合并汇总后的单元格真的长数字显示为6.271E+18之类，不知道应该怎么修改，烦请各位大神帮忙！谢谢！不胜感激！！见黄色部分。
问题示例.rar (132.72 KB, 下载次数: 6)

2024-9-30 10:09 上传

点击文件名下载附件

1. Sub 汇总工作簿为总表()
   
2.     Dim shtData As Worksheet
   
3.     Dim nTitleRow As Long, i As Long, j As Long, nStartRow As Long
   
4.     Dim aData, aResult(), rng As Range
   
5.     Dim strPath As String, strFileName As String
   
6.     Dim nShtCount As Long, k As Long
   
7. 
   
8.     ' 选择文件夹
   
9.     strPath = IIf(Application.FileDialog(msoFileDialogFolderPicker).Show, _
   
10.     Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1), "")
    
11.     If Right(strPath, 1) <> "" Then strPath = strPath & ""
    
12.     ' 输入标题行数
    
13.     nTitleRow = Val(InputBox("请输入标题的行数，默认标题行数为1", "提醒", 1))
    
14. 
    
15.     Application.ScreenUpdating = False: Application.DisplayAlerts = False
    
16.     ReDim aResult(1 To 10000, 1 To 100)  '这里限制行数和列数
    
17.     ' 遍历文件夹内的文件
    
18.     strFileName = Dir(strPath & "*.xls*")
    
19.     Do While strFileName <> ""
    
20.         If strFileName <> ThisWorkbook.Name Then
    
21.            With GetObject(strPath & strFileName)
    
22.                 For Each shtData In .Worksheets
    
23.                     ' 设置工作表范围
    
24.                     Set rng = shtData.UsedRange
    
25.                     ' 检查工作表是否有数据
    
26.                     If rng.Rows.Count > 1 Then
    
27.                         nShtCount = nShtCount + 1
    
28.                         nStartRow = IIf(nShtCount = 1, 1, nTitleRow + 1)
    
29.                         ' 将工作表数据存储到数组中
    
30.                         aData = rng.Value
    
31.                         For i = nStartRow To UBound(aData)
    
32.                             k = k + 1
    
33.                             ' 将工作表数据复制到结果数组中
    
34.                             For j = 1 To UBound(aData, 2)
    
35.                                 aResult(k, j) = aData(i, j)  '行数和列数超出范围，运行到这里会出现错误，调增行数和列数即可。
    
36.                             Next j
    
37.                         Next i
    
38.                     End If
    
39.                 Next shtData
    
40.                 .Close False
    
41.             End With
    
42.         End If
    
43.         strFileName = Dir
    
44.     Loop
    
45.     Range("A1").Resize(k, UBound(aResult, 2)) = aResult
    
46.     Application.ScreenUpdating = True: Application.DisplayAlerts = True
    
47. End Sub
    

复制代码

lhteee

怎么看不到！

Yalishanda30

lhteee 发表于 2024-9-30 10:44
怎么看不到！

改一下试试

lhteee

Yalishanda30 发表于 2024-9-30 13:28
改一下试试

谢谢！！！完美解决。
我把7改为13了。
非常感谢！！！