12
返回列表 上一主題 發帖

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

edmondsforum

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

論壇贊助勳章
6# 跳轉到 »
發表於 2020-7-28 09:55 | 只看該作者
不好意思，忘了提及一件事
就是 單價分析總表的 欄寬 能保持不變嗎
因為我原本就設定好了

TOP

edmondsforum

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

論壇贊助勳章
5#
發表於 2020-7-28 09:32 | 只看該作者
回復 3# 准提部林


    感謝准大!!!  快狠準耶!!
    準大，我這邊的問題也是一樣，

   1.單價分析總表的項次，能依照各子項單價分析編號 一 二 三 四 五 依照排序複製過來嗎?
      我有試著改 排水溝-單價分析 把它改成 五 ，它還是排第一個。

   2.能讓單價分析總表全部都變成黑色嗎?  (雖然手動改就好XD) 我發現 單位 那邊都會變成 紅色

TOP

edmondsforum

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

論壇贊助勳章
4#
發表於 2020-7-28 09:29 | 只看該作者
回復 2# jcchiang

謝謝J大 相當成功!!
這邊有兩個問題想請教：
1.單價分析總表的項次，能依照各地子項單價分析編號 一 二 三 四 五 依照排序複製過來嗎?
   我有試著改 排水溝-單價分析 把它改成 五 ，它還是排第一個。

2.能讓單價分析總表全部都變成黑色嗎?  (雖然手動改就好XD) 我發現 單位 那邊都會變成 紅色

TOP

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-8 
3#
發表於 2020-7-23 13:00 | 只看該作者
Sub TEST()
Dim xR As Range, xS As Worksheet, xU As Range
With Sheets("單價分析總表")
     .UsedRange.Offset(5, 0).EntireRow.Delete
     Set xR = .[B6]
End With
For Each xS In Sheets
    If Right(xS.Name, 4) <> "單價分析" Then GoTo 101
    Set xU = Intersect(xS.[B:H], xS.UsedRange).Offset(1, 0)
    With xR.Resize(xU.Rows.Count, xU.Columns.Count)
         xU.Copy .Cells
         .Value = .Value
    End With
    Set xR = xR(xU.Rows.Count + 1)
101: Next
Range(xR(-xR.Row + 3, 1), xR(-1, 7)).Name = "Print_Area"
End Sub

第６行以上自行處理∼∼
　
　
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
2#
發表於 2020-7-23 09:02 | 只看該作者
回復 1# edmondsforum

試試看是否符合
Sub ex()
Dim sht As Object
Dim r%
r = 6
Sheets("單價分析總表").Cells.Clear
For Each sht In Worksheets
   If sht.Name Like "*單價分析" Then
      With Sheets(sht.Name)
         .Range(.[b2], .Cells(.[c65535].End(3).Row, 8)).Copy Sheets("單價分析總表").Cells(r, 2)     
         r = r + .[c65535].End(3).Row
      End With
   End If
Next
With Sheets("單價分析總表")
   .Cells.Font.Name = "華康隸書體W5"
   .[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  
   .Columns("A:I").AutoFit
End With
End Sub

TOP

        靜思自在 : 愛不是要求對方，而是要由自身的付出。
12
返回列表 上一主題