麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 辨認及匯總 [打印本頁]

作者: 198188 時間: 2024-3-6 12:40 標題: 辨認及匯總

[attach]37561[/attach][attach]37562[/attach]

有工作表 1 - 4
如上圖舉例

1. 工作表 Total  "架號"  （欄A 對應工作表1，欄G 對應工作表2，欄M 對應工作表3，欄S對應工作表4）
順序讀出工作表 1 - 4 的 A 欄號碼  （不要重複數據）

2.  工作表 Total  "工程"  （欄B 對應工作表1，欄H 對應工作表2，欄N對應工作表3，欄T對應工作表4）
根據架號讀取工作表 1 - 4 的 M 欄（刪除重複資料, 舉例 (BF, BF 顯示BF) (BF, BH, BF, BH 顯示BF/BH)

3. 工作表 Total  "廠"  （欄 C/D 對應工作表1，欄 I/J 對應工作表2，欄 O/P 對應工作表3，欄 U/V 對應工作表4）
根據架號讀取工作表 1 - 4 的 N / O 欄 ( N 欄對應 C / I / O / U欄,  O 欄對應 D / J / P / V欄)
如果N欄内顯示“噴油” or  不等於空格， C / I / O / U欄顯示 "KH" (按照工作表來分配欄位）
如果O欄内顯示“噴油” or  不等於空格， D / J / P / V欄顯示 "KP"  (按照工作表來分配欄位）
如果N/O欄内都是空格，  C / I / O / U欄顯示 "KH" (按照工作表來分配欄位）

4. 工作表 Total  "處理"  （欄E 對應工作表1，欄K 對應工作表2，欄Q對應工作表3，欄W對應工作表4）
根據架號讀取工作表 1 - 4 的 N 欄 / O 欄 ,
如果任何一格有“噴油” ，工作表Total 顯示“噴油”,
如果全部都是空格，工作表Total 顯示 "-"

作者: 198188 時間: 2024-3-6 17:04

回復 1# 198188

架號 = 我用下面的方式去做到。（工程 / 厰處理）三部分有點困難。

Sub TOTAL()
Dim A, B, C, D, E, F, G, H, I, J As Integer
A = Sheets(1).Range("A1").CurrentRegion.Rows.Count
B = Sheets(2).Range("A1").CurrentRegion.Rows.Count
C = Sheets(3).Range("A1").CurrentRegion.Rows.Count
D = Sheets(4).Range("A1").CurrentRegion.Rows.Count

F = 3
For G = 2 To A - 1
I = Worksheets("1").Range("A" & G)
If Worksheets("1").Range("A" & G) <> 0 Then
Worksheets("Total").Range("A" & F) = Worksheets("1").Range("A" & G)
F = F + 1
End If
Next G

F = 3
For G = 2 To B - 1
I = Worksheets("2").Range("A" & G)
If Worksheets("2").Range("A" & G) <> 0 Then
Worksheets("Total").Range("G" & F) = Worksheets("2").Range("A" & G)
F = F + 1
End If
Next G

F = 3
For G = 2 To C - 1
I = Worksheets("3").Range("A" & G)
If Worksheets("3").Range("A" & G) <> 0 Then
Worksheets("Total").Range("M" & F) = Worksheets("3").Range("A" & G)
F = F + 1
End If
Next G

F = 3
For G = 2 To D - 1
I = Worksheets("4").Range("A" & G)
If Worksheets("4").Range("A" & G) <> 0 Then
Worksheets("Total").Range("S" & F) = Worksheets("4").Range("A" & G)
F = F + 1
End If
Next G

End Sub

作者: 198188 時間: 2024-3-7 09:09

回復 2# 198188

附上範例

作者: 198188 時間: 2024-3-8 08:13

回復 3# 198188

上載錯了。這個才對

作者: Andy2483 時間: 2024-3-11 10:41

回復 1# 198188

規則:如果N/O欄内都是空格， C / I / O / U欄顯示 "KH" (按照工作表來分配欄位）
請教架號 148的廠I 是KH 還是空格??

作者: 198188 時間: 2024-3-11 11:08

回復 5# Andy2483

第2櫃
架號 134 ， 136， 148， 149， 150 在厰的位置應該顯示 "KH" 才對。附上更新的範例。

作者: Andy2483 時間: 2024-3-11 11:23

回復 6# 198188

以下是學習陣列與字典的方案,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, N&, R&, s%, T$, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
Sheets("Total").UsedRange.ClearContents: Set xR = [Total!A3]
For s = 1 To 4
Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
For i = 2 To UBound(Brr)
   If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
   If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
   If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
   If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
   If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
   If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
   If Brr(i, 14) = "噴油" Or Brr(i, 15) = "噴油" Then Crr(R, 5) = "噴油"
   If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> "噴油" Then Crr(R, 5) = "-"
i01: Next
xR.Resize(N, 5) = Crr: xR(0).Resize(, 5) = [{"架號","工程","廠","","處理"}]: xR(-1) = Sheets(s).Name & "櫃"
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
Next
End Sub

作者: 198188 時間: 2024-3-11 12:00

回復 7# Andy2483

謝謝前輩指點，符合到範例要求，由於中文簡繁體問題，所以我做了以下調整。

Option Explicit
Sub Total()
Dim Brr, Crr, Z, i&, N&, R&, s%, T$, xR As Range
Dim a, b As Integer
Set Z = CreateObject("Scripting.Dictionary")
Sheets("Total").Range([W3], [A65536].End(xlUp)(3)).Delete Shift:=xlUp: Set xR = [Total!A3]

For s = 1 To 4
Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
For i = 2 To UBound(Brr)
   If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
   If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
   If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
   If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
   If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
   If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
   If Brr(i, 14) = Sheets("KP").Range("C1") Or Brr(i, 15) = Sheets("KP").Range("C1") Then Crr(R, 5) = Sheets("KP").Range("C1")
   If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> Sheets("KP").Range("C1") Then Crr(R, 5) = "-"
i01: Next
xR.Resize(N, 5) = Crr: xR(-1) = "No." & Sheets(s).Name
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
Next

a = Cells(Rows.Count, 1).End(3).Row

With Range("A3", "E" & a)
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 7).End(3).Row

With Range("G3", "K" & a)
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 13).End(3).Row

With Range("M3", "Q" & a)
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 19).End(3).Row

With Range("S3", "W" & a)
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
End With

End Sub

作者: Andy2483 時間: 2024-3-12 15:26

謝謝論壇,謝謝各位前輩
後學藉此帖修訂方案複習註解如下,請各位前輩指教

Option Explicit
Sub Total()
Dim Arr, Brr, Crr, Z, i&, N&, R&, s%, T$, A$, xR As Range, xT As Range
'↑宣告變數:&是長整數,%是短整數,沒有指定的是通用型變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是字典
With Sheets("Total").UsedRange
.Offset(2).EntireRow.Delete
.Offset(, 5).EntireColumn.Delete
Set xT = .Item(1).Resize(2, 5): Set xR = .Item(3, 1): A = [KP!C1]
End With '此段是留下一個標題儲存格,其餘舊資料欄/列刪除
For s = 1 To 4
'↑設順迴圈!令s變數從1 到4
Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
'↑令Brr變數是寫入區域儲存格值的二維陣列,宣告Crr變數是二維空陣列
For i = 2 To UBound(Brr)
'↑設順迴圈!令i變數從2 到Brr陣列縱向最大索引列號
   If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
   If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
   If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
   If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
   If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
   If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
   If Brr(i, 14) = A Or Brr(i, 15) = A Then Crr(R, 5) = A
   If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> A Then Crr(R, 5) = "-"
i01: Next '此段是依條件將結果寫入Crr陣列中
xT.Copy xR(-1): xR(-1) = "No." & Sheets(s).Name
'↑令標題儲存格複製到目標格,令標題格寫入工作表名
With xR.Resize(N, 5)
   .Value = Crr
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .Columns(3).Font.ColorIndex = 3
   .Columns(4).Font.ColorIndex = 5
   .Font.Bold = True
End With '此段是令擴展適量儲存格範圍以Crr陣列值寫入,並調整該範圍格式
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
'↑令N變數歸零,Z字典清空,令xR變數右移到自身開始的第7格
Next
End Sub

作者: 198188 時間: 2024-3-13 08:14

回復 9# Andy2483

謝謝前輩指點

作者: 198188 時間: 2024-3-13 17:19

回復 9# Andy2483
改爲這個之後，如果不是四個櫃都有資料的話，那麽會顯示ERROR "1004" 應用程式或物件定義上OI*.

   xT.Copy xR(-1): xR(-1) = "No." & Sheets(s).Name
'↑令標題儲存格複製到目標格,令標題格寫入工作表名
With xR.Resize(N, 5)
   .Value = Crr
   .Borders.LineStyle = 1
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .Columns(3).Font.ColorIndex = 3
   .Columns(4).Font.ColorIndex = 5
   .Font.Bold = True
End With '此段是令擴展適量儲存格範圍以Crr陣列值寫入,並調整該範圍格式
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
'↑令N變數歸零,Z字典清空,令xR變數右移到自身開始的第7格
Next

作者: Andy2483 時間: 2024-3-14 07:22

回復 11# 198188

Sub Total()
~~
Brr = Sheets(s).[A1].CurrentRegion: If Not IsArray(Brr) Then GoTo s01 Else ReDim Crr(1 To UBound(Brr), 1 To 5)
'↑令Brr變數是寫入區域儲存格值的二維陣列,如果Brr不是陣列就跳到標示s01位置繼續執行,否則宣告Crr變數是二維空陣列
~~
s01: Next
End Sub

作者: 198188 時間: 2024-3-14 08:25

回復 12# Andy2483

請問這句加在哪個位置

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)