为什么dir读取不了另外一人的信息》？？？

cocobobo

请问dir为什么读取不了两个的信息，只能读取一个人？

xiangbaoan

'这是原来的，在上面改了一点点
Sub 汇总171()
   Dim myPath$, myFile$, AK As Workbook, tcol%, i As Integer
   Application.ScreenUpdating = False
   [a3:ar500].ClearContents
   myPath = ThisWorkbook.Path & "\"
   myFile = Dir(myPath & "*.xls")
   Do While myFile <> ""
      If myFile <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(myPath & myFile)
'    Else
'         GoTo 100
'      End If
        With ThisWorkbook.Sheets(1)
        r = .Range("b65536").End(xlUp).Row + 1
      .Cells(r, 2) = AK.Sheets(1).Range("d5") '姓名优抚对象
      .Cells(r, 6) = AK.Sheets(1).Range("d6") '身份证
      .Cells(r, 13) = AK.Sheets(1).Range("f12") '金额
      .Cells(r, 14) = AK.Sheets(1).Range("g12") '银行账号
         
         .Cells(r, 16) = AK.Sheets(1).Range("e13") '现金
      .Cells(r, 17) = AK.Sheets(1).Range("f13") '金额
      .Cells(r, 18) = AK.Sheets(1).Range("g13") '银行账号
      
      .Cells(r, 20) = AK.Sheets(1).Range("e14") '现金
      .Cells(r, 21) = AK.Sheets(1).Range("f14") '金额
      .Cells(r, 22) = AK.Sheets(1).Range("g14") '银行账号
      
      .Cells(r, 25) = AK.Sheets(1).Range("f15") '金额
      .Cells(r, 26) = AK.Sheets(1).Range("g15") '银行账号
        
      .Cells(r, 29) = AK.Sheets(1).Range("f16") '金额
      .Cells(r, 30) = AK.Sheets(1).Range("g16") '银行账号
      
      .Cells(r, 33) = AK.Sheets(1).Range("f17") '金额
      .Cells(r, 34) = AK.Sheets(1).Range("g17") '银行账号
      
      .Cells(r, 41) = AK.Sheets(1).Range("f19") '金额
      .Cells(r, 42) = AK.Sheets(1).Range("g19") '银行账号
       End With
      
      
     AK.Close False
     End If
     
        
' Workbooks(myFile).Close False
      myFile = Dir
   Loop
'100:
   Application.ScreenUpdating = True
   MsgBox "汇总完成！", 64, "提示"

            
End Sub

huang1314wei

F8单步运行不会吗？  你那明显是End If  放错了位置，不明白你代码加个 goto 100  是什么目的？

xiaoxia520

表格太复杂了，具体的内容你可以自己改改，我简单的写了下遍历文件夹的方法，弹窗出两个名字而已

1. Sub test()
   
2. Dim pathn$, f$, book As Workbook
   
3. pathn = ThisWorkbook.Path
   
4. f = Dir(pathn & "")
   
5. Do While f <> ""
   
6.     If f <> ThisWorkbook.Name Then
   
7.         Workbooks.Open pathn & "" & f
   
8.         Set book = ActiveWorkbook
   
9.         Name = book.Worksheets(1).Cells(5, 4)
   
10.         ActiveWorkbook.Close False
    
11.         MsgBox Name
    
12.     End If
    
13. f = Dir()
    
14. Loop
    
15. End Sub
    

复制代码

新手上路。