PJChen

回復 20# 准提部林
准大,
執行後發現報表改成了訂單統計而不是缺料表,它的應抓取範圍是AP:BH

我主要是想了解您之前回覆的程式
For C = 45 To UBound(Arr, 2)
    Ck = 0
    If Arr(3, C) = "劃單合計" Then Exit For  '加入這一行, 以[劃單合計]判斷廠缺欄位的結束點
這個方式,我試不出來,想知道要怎麼修改

以下是之前程式run的結果,我只是想要加入紅字的部份 & 檔案 廠缺表_amd3.rar (184.24 KB)

下載次數: 0

2020-3-1 19:54

下載 (36.49 KB)

2020-3-1 19:35

PJChen

大大好,

最近有一個新的表格需求: 將廠缺資料匯總,條件為以下,請問VBA要如何寫?
1..        飛比BI欄大於0的資料,填入A3:F
2..        A3:F資料值化
3..        將第3列的格式向下複製
廠缺匯總.rar (179.22 KB)

下載次數: 2

2020-4-16 22:44

准提部林

回復 22# PJChen

Sub 廠缺匯總_匯入()
Dim Arr, R&, 廠缺數&, 入數&, N&
Call 廠缺匯總_清除
Arr = Range([飛比!A1], [飛比!BI65536].End(xlUp))
For R = 4 To UBound(Arr)
    廠缺數 = Val(Arr(R, UBound(Arr, 2)))
    入數 = Val(Arr(R, 7))
    If 廠缺數 * 入數 = 0 Then GoTo 101
    N = N + 1
    Arr(N, 1) = Arr(R, 6)
    Arr(N, 2) = Arr(R, 5)
    Arr(N, 3) = Arr(R, 8)
    Arr(N, 4) = 入數
    Arr(N, 5) = 廠缺數 Mod 入數
    Arr(N, 6) = Int(廠缺數 / 入數)
101: Next R
If N = 0 Then Exit Sub
With [廠缺匯總!A3:F3].Resize(N)
     .Rows(1).Copy .Cells
     .Value = Arr
End With
End Sub


Sub 廠缺匯總_清除()
With Sheets("廠缺匯總")
    .UsedRange.Offset(3, 0).EntireRow.Delete
    .[A3:F3].ClearContents
End With
End Sub


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

PJChen

回復 23# 准提部林

准大好,

不好意思,這個新表格是這幾天才啟用,發現格式沒做好,要更改如下
另外 表格中取出的瓶數及箱數 數值都不正確,我把正確答案列出,也請幫忙修正...再次感謝
最新庫存A_2.rar (178.15 KB)

下載次數: 0

2020-4-17 22:17

下載 (14.49 KB)

2020-4-17 22:13

PJChen

回復 23# 准提部林

准大,
感謝你,我改好了

PJChen

回復 23# 准提部林

准大,
我修改了這個程式,想讓
HD欄>0,則填入,最後效期sheet的J欄
HE欄>0,則填入,最後效期sheet的K欄
目前只try了HE欄,但無法填入,可以幫我看看嗎?    最新庫存.rar (82.58 KB)

下載次數: 1

2020-6-16 00:14

1. Sub  最後效期()
   
2. Dim Arr, Brr, R&, 統&, N&, BK As Workbook
   
3. Set BK = Workbooks("最新庫存.xlsx")
   
4. BK.Sheets("最後效期").Activate
   
5. Arr = Range([飛比!A1], [飛比!HE65536].End(xlUp))
   
6. For R = 4 To UBound(Arr)
   
7.     統 = Val(Arr(R, UBound(Arr, 2)))
   
8.     If 統 = 0 Then GoTo 101
   
9.     N = N + 1
   
10.     Arr(N, 11) = Arr(R, 5) '料號
    
11. 101: Next R
    
12. If N = 0 Then Exit Sub
    
13. 
    
14. With [最後效期!A4:H4].Resize(N)
    
15.      .Rows(1).Copy .Cells
    
16. End With
    
17. With [最後效期!L4:AB4].Resize(N)
    
18.      .Rows(1).Copy .Cells
    
19. End With
    
20. End Sub

複製代碼

准提部林

回復 26# PJChen

你這程式碼根本拿不到任何資料!!!
應該是完全不了解原程式碼的意思, 這樣是無法套用的~~

光是這不成套的程式碼及簡單的說明, 無法了解詳細需求規則,
好像每次的提問, 我幾乎都抓不到要的是什麼???只能用猜,
這總不是辦法, 或許再研究一下提問方式, 讓別人都可了解清楚你的目的!!!

PJChen

回復 27# 准提部林

最後效期,A4:H4,L4:AB4原來都有公式,作為動態表格使用,
程式只有做二個動作:
1) 將來源料號填入J:K欄,
2) 最後依據K欄的列數,將A4:H4,L4:AB4的公式下拉即可  
最後效期.rar (82.19 KB)

下載次數: 2

2020-6-16 12:42

下載 (22.64 KB)

2020-6-16 12:41

准提部林

回復 28# PJChen


Sub 最後效期()
Dim Arr, Brr, Crr, R&, i&, N&, BK As Workbook
Set BK = Workbooks("最新庫存.xlsx")
BK.Sheets("最後效期").Activate
R = [飛比!HE65536].End(xlUp).Row
Arr = Sheets("飛比").Range("F1:F" & R)
Brr = Sheets("飛比").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
    If Val(Brr(i, 1)) + Val(Brr(i, 2)) = 0 Then GoTo 101
    N = N + 1
    If Brr(i, 1) > 0 Then Crr(N, 1) = Arr(i, 1)
    If Brr(i, 2) > 0 Then Crr(N, 2) = Arr(i, 1)
101: Next i
If N = 0 Then Exit Sub
With Sheets("最後效期")
    .[J4:K4].Resize(N) = Crr
    If N > 1 Then
      .[L4:AB4].Copy .[L5:AB5].Resize(N - 1)
      .[A4:H4].Copy .[A5:H5].Resize(N - 1)
    End If
End With
End Sub

PJChen

回復 29# 准提部林

准大,
1) 如圖,如何使J欄&K欄資料可以連續,且都從第4列開始載入資料?
2) 請問For i = 4 To R
該如何理解紅字部份?為何是4?

下載 (7.88 KB)

2020-6-16 16:52

最新庫存A.rar (85.21 KB)

下載次數: 3

2020-6-16 16:52