帖子: 41
主題: 7
精華: 0
積分: 52
點名: 0
作業系統: Windows10
軟體版本: 2019
閱讀權限: 20
性別: 男
註冊時間: 2017-11-28
最後登錄: 2024-2-1

論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2020-7-22 10:16 | 只看該作者

[發問] 請教，如何複製不同工作表特定欄位(忽略空白值)到一個工作表上

各位大神好，小弟今天遇到我有不同的工作表，大概10個(不同個名稱，如 XXXX-單價分析)
他們的格式都一樣，今天想把他們全部彙整到一個工作表，原本使用錄製巨集，
但是我不知道如何加寫讓它自動判斷每個表格之間都會隔一列。

檔案如附件～

1090722-TEST.zip (25.41 KB)

單價分析總表就是我要的結果再拜託各位大大指點迷津

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

15^#

發表於 2023-12-6 10:34 | 只看該作者

謝謝論壇,謝謝各位前輩
後學藉此帖學習到很多知識,以1#範例的學習方案如下,請各位前輩指教

單價分析分表:

單價分析總表執行結果:

Option Explicit
Sub TEST()
Dim Z, Q, i&, R&, V&, c%, xR As Range, xA As Range, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Set Sh = 工作表1: Range(Sh.[A1], Sh.UsedRange).Offset(5).Delete
Set xR = [單價分析總表!B6]
For i = 0 To 10: Z(Right(Application.Text(i, "[DBNum1]"), 1)) = i: Next
For i = 1 To Worksheets.Count
If Right(Trim(Sheets(i).Name), 5) <> "-單價分析" Then GoTo i01
Q = Trim(Sheets(i).[B2]) & "○○○"
For c = 1 To 3: V = Val(V & Z(Mid(Q, c, 1))): Next
Set Z(V) = Sheets(i): V = 0
i01: Next
For i = 1 To Z.Count
Q = Application.Small(Z.Keys, i)
If IsError(Q) Then Exit For
Set xA = Range(Z(Q).[B2], Z(Q).[G65536].End(3)(1, 2))
xA.Copy xR
Set xR = xR.Item(xA.Rows.Count + 2)
Next
With Sh.UsedRange: .Font.ColorIndex = 1: .Value = .Value: End With
Range(Sh.[A1], xR(-1, 8)).Name = "Print_Area"
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

edmondsforum

中學生 Rank: 2

帖子: 41
主題: 7
精華: 0
積分: 52
點名: 0
作業系統: Windows10
軟體版本: 2019
閱讀權限: 20
性別: 男
註冊時間: 2017-11-28
最後登錄: 2024-2-1

論壇贊助勳章

14^#

發表於 2020-8-7 10:49 | 只看該作者

回復 12# 准提部林

謝謝准大，小弟佩服得五體投地啊！
報告准大，小弟有發現你格式原本是使用 [DBNum1]0
因為我想要呈現十十一十二所以我改成 [DBNum1][$-ja-JP]G/通用格式

TOP

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2024-9-23

13^#

發表於 2020-8-5 22:09 | 只看該作者

以下是試著練習的結果程式很攏長請大大們指點一下看看有沒有地方不適合這樣的寫法
請告知小弟請問如果要設定列印分頁的頁數範圍該如何寫呢? 請大大們幫幫忙

Sub 測試練習()
Application.ScreenUpdating = False
Dim A()
For I = 2 To Sheets.Count
ReDim Preserve A(I - 1)
A(I - 1) = Sheets(I).Cells(2, 2)
Next I
G = Application.Max(A)
ActiveWorkbook.Save
For k = 1 To G
For I = 2 To Sheets.Count
Sheets(I).Select
If Format(Sheets(I).Cells(2, 2), "[DBNum1]0") = Format(k, "[DBNum1]0") Then
If Sheets(1).Cells(6, 2) = "" Then
Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(6, 2)
ElseIf Sheets(1).Cells(6, 2) <> "" Then
u = Sheets(1).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(2, 0).Address(0, 0)
Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(Mid(u, 2), 2)
End If
End If
Next I
Next k
Sheets(1).Select
Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(0, 1).Address(0, 0)).Name = "Print_Area"
Application.ScreenUpdating = True
End Sub

複製代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

12^#

發表於 2020-8-4 16:54 | 只看該作者

用字典帶入編號:

Xl0000176-1.rar (23.13 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

11^#

發表於 2020-8-4 13:33 | 只看該作者

本帖最後由准提部林於 2020-8-4 16:44 編輯

回復 9# edmondsforum

編號限定 1 ~ 99
更正檔:

Xl0000176.rar (23.88 KB)

TOP

edmondsforum

中學生 Rank: 2

帖子: 41
主題: 7
精華: 0
積分: 52
點名: 0
作業系統: Windows10
軟體版本: 2019
閱讀權限: 20
性別: 男
註冊時間: 2017-11-28
最後登錄: 2024-2-1

論壇贊助勳章

10^#

發表於 2020-8-4 11:25 | 只看該作者

回復 8# jcchiang

  謝謝大大，中文大寫排序果然很麻煩，
  最後，如果是以純數字排列呢，例如工程項次裡面是 1 2 3 4 5 ， 10 21 35 41 之類的話
  這樣可以不用手改了嗎? 再拜託你了

TOP

edmondsforum

中學生 Rank: 2

帖子: 41
主題: 7
精華: 0
積分: 52
點名: 0
作業系統: Windows10
軟體版本: 2019
閱讀權限: 20
性別: 男
註冊時間: 2017-11-28
最後登錄: 2024-2-1

論壇贊助勳章

9^#

發表於 2020-8-4 11:14 | 只看該作者

回復 7# 准提部林

回覆准大
1. 十以上就是直接變成十一十二、二十一、三十五之類的。
2.同一個工作表不太可能跳號。
3.不同工作表不會同號。
那如果改成中文數字 1 2 3 4 5 6... 10 11 21 31 是否可行呢

不好意思准大！我會盡量靠自己去找程式碼!! :P

TOP

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

8^#

發表於 2020-7-29 10:42 | 只看該作者

本帖最後由 jcchiang 於 2020-7-29 10:51 編輯

回復 4# edmondsforum

准大已經點出很多可能的問題,先以檔案的資料做程式調整,其餘部份請自行修改

Sub ex1()
Dim arr, a, c, B%, QQ%, R%
Dim sht As Object
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Sheets("單價分析總表").Cells.Clear
arr = Array("一", "二", "三", "四", "五")  '工程項次
For Each sht In Worksheets
If sht.Name Like "*單價分析" Then
   With Sheets(sht.Name)
      For Each a In .Range(.[b2], .[b65535].End(3))
         For x = 0 To UBound(arr)
            If a.Value = arr(x) And Not d.Exists(a.Value) Then d.Add a.Value, sht.Name & "@" & a.Address
         Next
      Next
   End With
End If
Next
R = 6
For Each a In arr
For B = 0 To d.Count - 1
   If a = d.keys()(B) Then
      c = Split(d.items()(B), "@")
      With Sheets(c(0))
         For QQ = 1 To 100
            If .Range(c(1)).Offset(QQ, 1) = "小計" Then Exit For
         Next
         .Range(c(1)).Resize(QQ + 2, 8).Copy Sheets("單價分析總表").Cells(R, 2)
         R = R + QQ + 3
      End With
   End If
   Next
Next
With Sheets("單價分析總表")
.Cells.Font.Name = "華康隸書體W5"
.Cells.Font.ColorIndex = 1
.[b5].Value = "項次"
.[b5].HorizontalAlignment = xlCenter
With .Range("B2:H2")
   .Merge
   .Value = "感謝麻辣家族討論版"
   .HorizontalAlignment = xlCenter
   .Font.Bold = True
   .Font.Size = 16
End With
With .Range("B3:H3")
   .Merge
   .Value = "單價分析表"
   .HorizontalAlignment = xlCenter
   .Font.Underline = xlUnderlineStyleSingle
   .Font.Size = 14
End With
.Range("c4:H4").Merge
.[c4].Value = "工程名稱：麻辣家族討論版"
.Range("c5:H5").Merge
.[c5].Value = "工程編號：Excelvba"
.Range(.[b6], .Cells(.[c65535].End(3).Row, 8)) = .Range(.[b6], .Cells(.[c65535].End(3).Row, 8)).Value
End With
Set d = Nothing
End Sub

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

7^#

發表於 2020-7-28 12:49 | 只看該作者

本帖最後由准提部林於 2020-7-28 12:52 編輯

回復 5# edmondsforum

1.單價分析總表的項次，能依照各子項單價分析編號一二三四五依照排序複製過來嗎?

1) 最多到幾? 10以上,又是怎麼標?
10 = "一十" 或 "十" 或 "一○"
12 = "十二" 或 "一十二"

2) 同一工作表，會不會跳號？或同號
3) 不同工作表, 會不會同號?

中文大寫的數字, 這不太好弄~~最好自行先將工作表順序手動調一調~~或定義工作表名稱順序
至於文字顏色及格式, 應該不難, 可自行去修改或補入程式碼~~樣樣伸手牌不是好習慣

======================================

TOP