帖子: 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

大學生 Rank: 4

帖子: 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

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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

Sub Compare()
Dim R As Integer, C As Integer, TheCoL As Integer
On Error GoTo Er
With ActiveWorkbook
.Sheets.Add(, .Sheets(.Sheets.Count)).Name = "合併"
End With
With Sheets("合併")
.Move Sheets(2)
Sheets(3).Range("A1").CurrentRegion.Copy .[A1]
R = .[A1].End(xlDown).Row + 2
For C = 1 To Sheets(3).UsedRange.Columns.Count
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
With Sheets(i)
.Range(.Cells(R, C), .Cells(.Rows.Count, C)).Copy Sheets("合併").Cells(R, TheCoL)
End With
Next
Next
End With
Exit Sub
Er: '處裡 "合併" 工作表已存在
Application.DisplayAlerts = False
ActiveSheet.Delete
Sheets("合併").Delete
Application.DisplayAlerts = True
Resume
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

morris0914

中學生 Rank: 2

帖子: 19
主題: 4
精華: 0
積分: 62
點名: 0
作業系統: winxp
軟體版本: winxp
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2011-7-27
最後登錄: 2015-5-20

6^#

發表於 2013-6-4 10:07 | 只看該作者

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

Simon

TOP

morris0914

中學生 Rank: 2

帖子: 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

中學生 Rank: 2

帖子: 19
主題: 4
精華: 0
積分: 62
點名: 0
作業系統: winxp
軟體版本: winxp
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2011-7-27
最後登錄: 2015-5-20

8^#

發表於 2013-6-4 18:26 | 只看該作者

感謝大大的幫忙

Simon

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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的說明

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

morris0914

中學生 Rank: 2

帖子: 19
主題: 4
精華: 0
積分: 62
點名: 0
作業系統: winxp
軟體版本: winxp
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2011-7-27
最後登錄: 2015-5-20

10^#

發表於 2013-6-5 14:59 | 只看該作者

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

Simon

TOP