麻辣家族討論版版 » Excel程式區 » sheet1單儲存格資料傳送至sheet2的合併儲存格

返回列表下一主題上一主題發帖

[發問] sheet1單儲存格資料傳送至sheet2的合併儲存格

　暱稱: 伊恩

中學生 Rank: 2

帖子: 97
主題: 33
精華: 0
積分: 129
點名: 0
作業系統: Win 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2019-5-7
最後登錄: 2022-8-25

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2019-5-27 14:15 | 只看該作者

[發問] sheet1單儲存格資料傳送至sheet2的合併儲存格

要如何把sheet1單儲存格的資料傳送到sheet2合併的儲存格中
目前我的程式是這樣
只是不太會寫迴圈
因為sheet1的資料是會經過篩選而變動的

Sub teat1()
Set ma = Sheets("工作表6").Cells(1, "A").MergeArea
If Sheets("工作表6").Cells(1, "A").MergeCells Then
ma.Cells(1, "A").Value = Sheets("工作表5").Cells(1, "A")
End If
End Sub

複製代碼

樓主熱帖

收藏

　暱稱: zheng逸

中學生 Rank: 2

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

2^#

發表於 2019-5-27 17:23 | 只看該作者

本帖最後由 zheng211016 於 2019-5-27 17:25 編輯

把檔案放上來吧~ 順便把篩選條件都附上

　暱稱: 伊恩

中學生 Rank: 2

帖子: 97
主題: 33
精華: 0
積分: 129
點名: 0
作業系統: Win 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2019-5-7
最後登錄: 2022-8-25

3^#

發表於 2019-5-27 17:51 | 只看該作者

回復 2# zheng211016
依工作表1中的檢驗設備來進行篩選，也是依使用者需求選取變動的

test篩選傳送.rar (28.39 KB)

　暱稱: zheng逸

中學生 Rank: 2

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

4^#

發表於 2019-5-28 12:37 | 只看該作者

使用方法 : 手動篩選完後點擊匯出
篩選範圍 : 選擇藍色框框進行篩選(如圖)
篩選條件 : 請務必勾選空白(否則會出現偵錯原因是因為我的複製範圍是固定的)

test篩選複製.rar (27.74 KB)

　暱稱: 伊恩

中學生 Rank: 2

帖子: 97
主題: 33
精華: 0
積分: 129
點名: 0
作業系統: Win 7
軟體版本: office 2007
閱讀權限: 20
性別: 男
註冊時間: 2019-5-7
最後登錄: 2022-8-25

5^#

發表於 2019-5-28 13:56 | 只看該作者

回復 4# zheng211016
謝謝~我已經找到方法了

Sub test()
Dim temp(10)
Dim Meg As Boolean
Sheets("工作表1").Select
Sheets("工作表1").Range("A8").Select
'讀取sheet1篩選的資料並寫入sheet2................
K = 12
Do
ActiveCell.Offset(1).Select '活動單格下移一行
Meg = ActiveCell.MergeCells
If ActiveCell.Rows.Hidden = False And ActiveCell.Value <> "" And Meg = False Then
temp(1) = ActiveCell.Value
temp(2) = ActiveCell.Offset(0, 1).Value
temp(3) = ActiveCell.Offset(0, 4).Value
Sheets("工作表2").Cells(K + 1, 1) = temp(1)
Sheets("工作表2").Cells(K + 1, 2) = temp(2) & Chr(10) & temp(3)
K = K + 5
End If
Loop Until ActiveCell = "" Or Meg = True
'整理sheet2 格式................
K = 12
With Sheets("工作表2")
Do
If .Cells(K + 1, 1) <> "" Then
.Range(.Cells(K + 1, 1), .Cells(K + 5, 1)).Merge
.Range(.Cells(K + 1, 2), .Cells(K + 5, 2)).Merge
K = K + 5
Else
Exit Sub
End If
Loop
End With
End Sub

複製代碼

　暱稱: zheng逸

中學生 Rank: 2

帖子: 99
主題: 15
精華: 0
積分: 164
點名: 2
作業系統: WIN7
軟體版本: office2010
閱讀權限: 20
性別: 男
註冊時間: 2017-5-30
最後登錄: 2024-10-5

6^#

發表於 2019-5-28 18:52 | 只看該作者

回復 5# s13030029

摁看你哪個程式碼比較容易懂跟撰寫就用那個

靜思自在 : 虛空有盡．我願無窮，發願容易行願難。

返回列表下一主題上一主題