請教合併儲存格問題

morris0914

程式是合併多個工作表的值，如何寫成讀到沒有值才離開，而不是註解中的BB及50是設定固定值


Sub Compare()
        Dim Sh As Worksheet, i%, iRowEnd%, Ar()
     With ActiveWorkbook                 
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "合併"            
      End With
    With Sheets("合併")
        .Move Sheets(2)                     
        .UsedRange.Offset(1).ClearContents   
        For i = 2 To Sheets.Count           
            iRowEnd = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
            Ar = Sheets(i).Range("A2:BB" & iRowEnd).Value                                           '<========BB
            .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ar), 50) = Ar         '<====50        
        Next
    End With
End Sub

stillfish00

回復 1# morris0914
試試看

Sub Compare()
    Dim Sh As Worksheet, i%, iRowEnd%, iColEnd%, Ar()
    With ActiveWorkbook
        .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "合併"
    End With
    With Sheets("合併")
        .Move Sheets(2)
        .UsedRange.Offset(1).ClearContents
        For i = 2 To Sheets.Count
            iRowEnd = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
            iColEnd = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
            Ar = Sheets(i).Range("A2:" & .Cells(iRowEnd, iColEnd).Address).Value
            .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Ar), UBound(Ar, 2)) = Ar
        Next
    End With
End Sub

morris0914

感謝大大的幫忙
由於前10行有空白，所以
iColEnd = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
改為
iColEnd = Sheets(i).Cells(10, Columns.Count).End(xlToLeft).Column

morris0914

再請教大大，為何無法將多個檔案合併丫
可以將檔案變成範例1，檔案如附件

GBKEE

回復 4# morris0914

1. Sub Compare()
   
2.     Dim R As Integer, C As Integer, TheCoL As Integer
   
3.     On Error GoTo Er
   
4.     With ActiveWorkbook
   
5.         .Sheets.Add(, .Sheets(.Sheets.Count)).Name = "合併"
   
6.     End With
   
7.     With Sheets("合併")
   
8.         .Move Sheets(2)
   
9.         Sheets(3).Range("A1").CurrentRegion.Copy .[A1]
   
10.         R = .[A1].End(xlDown).Row + 2
    
11.         For C = 1 To Sheets(3).UsedRange.Columns.Count
    
12.             For i = 3 To Sheets.Count
    
13.                  TheCoL = .Cells(R, .Columns.Count).End(xlToLeft).Column + 1
    
14.                  If .Cells(R, .Columns.Count).End(xlToLeft) = "" Then TheCoL = 1
    
15.                 With Sheets(i)
    
16.                     .Range(.Cells(R, C), .Cells(.Rows.Count, C)).Copy Sheets("合併").Cells(R, TheCoL)
    
17.                 End With
    
18.             Next
    
19.         Next
    
20.     End With
    
21.     Exit Sub
    
22. Er:                    '處裡 "合併" 工作表已存在
    
23.     Application.DisplayAlerts = False
    
24.     ActiveSheet.Delete
    
25.     Sheets("合併").Delete
    
26.     Application.DisplayAlerts = True
    
27.     Resume
    
28. End Sub

複製代碼

morris0914

感謝版大的幫忙，我的VBA很弱，這程式我已經研究很久，一直寫不出來。
再次感謝版大的協助。

morris0914

再請教一下有些地方我不太了解

For C = 1 To Sheets(3).UsedRange.Columns.Count                                                                                    '我的頁面是(menu, 合併, 4.log, 5.log)為何是1 To Sheets(3)，而不是Sheets(3) to.....
            For i = 3 To Sheets.Count
                   TheCoL = .Cells(R, .Columns.Count).End(xlToLeft).Column + 1
                   If .Cells(R, .Columns.Count).End(xlToLeft) = "" Then TheCoL = 1                                         ' 為何讀到xlToLeft為空白時，TheCol=1，而不是用xlToright
                      With Sheets(i)
                          .Range(.Cells(R, C), .Cells(.Rows.Count, C)).Copy Sheets("合併").Cells(R, TheCoL)   '為何用到2次Cells
                      End With
            Next
Next

morris0914

感謝大大的幫忙

GBKEE

回復 7# morris0914
Q:我的頁面是(menu, 合併, 4.log, 5.log)為何是1 To Sheets(3)，而不是Sheets(3) to.....
A: Sheets(3).UsedRange.Columns.Count ,解釋: 第3個工作表(4.log).已使用範圍.欗位.物件數目= 4.log已使用範圍的欄數

Q:  為何讀到xlToLeft為空白時，TheCol=1，而不是用xlToright
TheCoL = .Cells(R, .Columns.Count).End(xlToLeft).Column + 1  '資料寫在左邊的欄位 + 1
A: 如此 A欗會空著

Q:為何用到2次Cells   
A:VBA的說明

1. Application、Range 及 Worksheet 物件時用 Range 屬性。
   
2. 傳回 Range 物件，該物件代表一個儲存格或儲存格範圍。
   
3. expression.Range(Cell1, Cell2)

複製代碼

morris0914

感謝板大超詳細的解譯，一看就懂