Hsieh

1. Sub ex()
   
2. Dim Ar(0 To 7), A As Range, C As Range, TCode, Cnt
   
3. Ar(0) = Array("客戶代號", "客戶批號", "Icode", "輸入量", "TCode", "B1", "B1失敗", "B2", "B2失敗", "B3", "B3失敗", "B4", "B4失敗")
   
4. Set A = Sheet2.[F:F].Find("A120004", lookat:=xlWhole)
   
5. If Not A Is Nothing Then
   
6.    For i = -3 To 3
   
7.       TCode = A.Offset(i, 7).Value
   
8.       Set C = Sheet1.[D:D].Find(TCode, lookat:=xlWhole)
   
9.       b1 = C.Offset(, 4).Value
   
10.       b2 = C.Offset(, 6).Value
    
11.       b3 = C.Offset(, 8).Value
    
12.       b4 = C.Offset(, 10).Value
    
13.       Cnt = A.Offset(i, 4).Value
    
14.       If Not C Is Nothing And TCode <> "" Then
    
15.       Ar(i + 4) = Array(A.Offset(i, -5).Value, A.Offset(i, 0).Value, A.Offset(i, 2).Value, Cnt, TCode, b1, b1 / Cnt, b2, b2 / Cnt, b3, b3 / Cnt, b4, b4 / Cnt)
    
16.          Else
    
17.       Ar(i + 4) = Array(A.Offset(i, -5).Value, A.Offset(i, 0).Value, A.Offset(i, 2).Value, Cnt, TCode, "NA#", "NA#", "NA#", "NA#", "NA#", "NA#", "NA#", "NA#")
    
18.       End If
    
19.   Next
    
20. End If
    
21. With Sheet3
    
22. .[A:M].ClearContents
    
23. For i = 7 To 13
    
24. .Columns(i).NumberFormat = "0.00%"
    
25. Next
    
26. .[A1].Resize(8, 13) = Application.Transpose(Application.Transpose(Ar))
    
27. End With
    
28. End Sub

複製代碼

回復 10# jcchiang

jcchiang

回復 11# Hsieh


    最後一個程式碼可以將0改成NA,但第2種情況無法執行(有TCode在Sheet1查無資料)
    目前將B1~B4資料改成
  If Not C Is Nothing And TCode <> "" Then b1 = C.Offset(, 4).Value
   If Not C Is Nothing And TCode <> "" Then b2 = C.Offset(, 6).Value
   If Not C Is Nothing And TCode <> "" Then b3 = C.Offset(, 8).Value
   If Not C Is Nothing And TCode <> "" Then b4 = C.Offset(, 10).Value
    則可執行第2種情形
   感謝H大耐心的指導,謝謝