請問前輩一個好難的VBA報表設計

tsou516

各位前輩，小弟為了工作需求，買了VBA的書，寫了一個爛的VBA去執行，產生需要的報表
但有太多的問題小弟沒辦法短時間突破，但老闆又要的非常急為了小弟的飯碗，小弟不得不
來和各位前軰求救，請各位前輩幫忙，跪謝！拜託拜託。

VBA.rar (24.31 KB)

Excel和說明
下載次數: 27

2014-1-17 17:36

GBKEE

回復 1# tsou516
將Sheet1.B01~B15的值放入規定的Sheet2.L欄~T欄的位置(有的要相加)
B01~B15有15欄 ,L欄~T欄有9欄,這欄數不對等,
你需說明 D-Pak,SO-8,PMPAK,SPR-PAK ,SOT-23,SOT-26,TO-220,TO-263 的條件

1. Sub 迴圈()
   
2.     Dim Rng As Range, M As Variant, E
   
3.     Set Rng = Sheets("SHEET3").Range("A:A")
   
4.     Sheets("SHEET2").UsedRange.Offset(1).Clear
   
5.     For Each E In Sheets("SHEET1").Range("A:A").SpecialCells(xlCellTypeConstants) '特殊儲存格(字串),排除空白儲存格.
   
6.         If E.Row > 1 Then        '排除表頭
   
7.             M = Application.Match(E, Rng, 0)  '搜尋Device在Rng的位置=列號
   
8.             If IsNumeric(M) Then              '是數字:有找到Device在Rng的位置
   
9.                 With Sheets("SHEET2").Cells(Sheets("SHEET2").Rows.Count, "A").End(xlUp).Offset(1) 'SHEET2 A欄 寫上的位置
   
10.                      'SHEET2 A欄 由下往上到有資料儲存格的下一列
    
11.                     .Range("A1") = Rng.Cells(M, 2)   'Package 在 Device 的右欄
    
12.                     .Range("B1") = E                 'Device
    
13.                     .Range("D1") = E.Range("C1")     'Datecode
    
14.                     .Range("E1") = E.Range("D1")     'Wafer ID
    
15.                     '*************************
    
16.                     '等候你的條件說明後寫程式碼
    
17.                     '*************************
    
18.                 End With
    
19.             End If
    
20.         End If
    
21.     Next
    
22. End Sub

複製代碼

tsou516

感謝前輩願意出手相救，萬分感謝，我再補上需求和條件的說明，再請您過目！

設計說明.rar (13.72 KB)

下載次數: 29

2014-1-18 03:12

GBKEE

回復 3# tsou516

1. Sub 迴圈()
   
2.     Dim Rng(1 To 6) As Range, E As Variant, M As Variant, M1 As Variant, i As Integer, ii As Integer
   
3.     With Sheets("sheet1")                                  '客戶資料
   
4.         If .[COUNTA(A:A)] <> .UsedRange.Rows.Count Then .Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete '刪除空白列
   
5.         For E = 0 To 14
   
6.             .[E1].Offset(, E).Name = .[E1].Offset(, E) & "值" '定義名稱:  B01 B02 B03 B04.....
   
7.         Next
   
8.     End With
   
9.     Sheets("Sheet2").UsedRange.Offset(1).Clear              '清除第二列(含)後的資料
   
10.     Set Rng(1) = Sheets("Sheet1").UsedRange.Columns(1)      '客戶資料
    
11.     Set Rng(2) = Sheets("Sheet2").Range("A:A")              '要寫入的範圍
    
12.     Set Rng(3) = Sheets("Sheet3").Range("A:A")              'Device
    
13.     Set Rng(4) = Sheets("Sheet4").Range("A:A")              'Package
    
14.     Set Rng(5) = Sheets("Sheet4").Range("B1:N1")            'Test out Q'ty,RG/SWT ....
    
15.     For Each E In Rng(1).Cells                              '客戶資料
    
16.         If E.Row > 1 Then                                   '排除表頭
    
17.             M = Application.Match(E, Rng(3), 0)             '搜尋Sheet1的Device在Sheet3的列位
    
18.             If IsNumeric(M) Then M1 = Application.Match(Rng(3).Cells(M, 2), Rng(4), 0)
    
19.                                                             'M1: 傳回Sheet3的Package在Sheet4的列位
    
20.             If IsNumeric(M) And IsNumeric(M1) Then
    
21.                 i = Application.CountA(Rng(2)) + 1          '計算有文字儲存格數
    
22.                 With Sheets("SHEET2").Cells(i, "A")         'SHEET2 A欄 寫上的位置
    
23.                     .Range("A1") = Rng(4).Cells(M1, 1)      'Sheet4對應的Package
    
24.                     .Range("B1") = E                        'Device
    
25.                     .Range("D1") = E.Range("C1")            'Datecode
    
26.                     .Range("E1") = E.Range("D1")            'Wafer ID
    
27.                     For Each C In Rng(5).Offset(M1 - 1)     '比對對應的'B01 B02 B03 B04.....
    
28.                         If C <> "" Then
    
29.                             M = Application.Match(C.Parent.Cells(1, C.Column), Rng(2).Cells(1).EntireRow, 0)   '搜尋Sheets("Sheet2")的欄位
    
30.                             'M=B01 B02 B03 B04.....上方第一列標頭在Sheet2第一列的欄位數
    
31.                             For ii = 0 To UBound(Split(C, "+")) '字串以"+"分割成陣列
    
32.                                 '.Parent.Cells(i, M) = .Parent.Cells(i, M) + Range(Split(C, "+")(ii)).Offset(E.Row - 1)           'SHEET4的格式 B01值 B02值 B03值 B04值.....
    
33.                                 .Parent.Cells(i, M) = .Parent.Cells(i, M) + Range(Split(C, "+")(ii) & "值").Offset(E.Row - 1)   'SHEET4的格式 B01 B02 B03 B04.....
    
34.                                 '.Parent -> Sheets("SHEET2")
    
35.                                 'Range(Split(C, "+")(ii) & "值"): 工作表上所定義名稱的位置
    
36.                             Next
    
37.                         End If
    
38.                     Next
    
39.                 End With
    
40.            Else
    
41.                 If Rng(6) Is Nothing Then
    
42.                     Set Rng(6) = E.EntireRow                    '比對不到的Device,Package
    
43.                 Else
    
44.                     Set Rng(6) = Union(Rng(6), E.EntireRow)     'Union 方法  傳回兩個或多個範圍的合併範圍。
    
45. 
    
46.                 End If
    
47.            End If
    
48.         End If
    
49.     Next
    
50.     If Not Rng(6) Is Nothing Then Rng(6).Delete
    
51. End Sub

複製代碼

tsou516

回復 4# GBKEE

非常感謝GBKEE版大的幫忙，讓我的工作能暫時保住，謝謝！