返回列表 上一主題 發帖

請教合併儲存格問題

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-31 17:32 | 只看該作者

請教合併儲存格問題

程式是合併多個工作表的值，如何寫成讀到沒有值才離開，而不是註解中的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
收藏 分享
Simon

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2013-5-31 19:47 | 只看該作者
回復 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

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
3#
發表於 2013-6-3 10:39 | 只看該作者
感謝大大的幫忙
由於前10行有空白，所以
iColEnd = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
改為
iColEnd = Sheets(i).Cells(10, Columns.Count).End(xlToLeft).Column
Simon

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
4#
發表於 2013-6-3 11:44 | 只看該作者
再請教大大，為何無法將多個檔案合併丫
可以將檔案變成範例1，檔案如附件

範例1.zip (81.88 KB)

文件範例1

test20130531.zip (128.58 KB)

主程式

Simon

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2013-6-3 17:35 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
6#
發表於 2013-6-4 10:07 | 只看該作者
感謝版大的幫忙，我的VBA很弱，這程式我已經研究很久，一直寫不出來。
再次感謝版大的協助。
Simon

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
7#
發表於 2013-6-4 10:53 | 只看該作者
再請教一下有些地方我不太了解

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
Simon

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
8#
發表於 2013-6-4 18:26 | 只看該作者
感謝大大的幫忙
Simon

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2013-6-5 14:43 | 只看該作者
回復 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)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

morris0914

帖子
19 
主題
4 
精華
0 
積分
62 
點名
0  
作業系統
winxp 
軟體版本
winxp 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2011-7-27 
最後登錄
2015-5-20 
10#
發表於 2013-6-5 14:59 | 只看該作者
感謝板大超詳細的解譯，一看就懂
Simon

TOP

        靜思自在 : 有心就有福，有願就有力，自造福田，自得福緣。
返回列表 上一主題