jcchiang

回復 1# PJChen

試試看
Sub ex()
r = [F65535].End(3).Row                    'F欄位數
[JQ4].Resize(r) = "=AH4-BR4"          'JQ4以下(以F欄位數量長度)置入公式
[JQ:JQ] = [JQ:JQ].Value                      '將公式轉為數值
End Sub

jcchiang

回復 7# PJChen

請參考!!
https://blog.csdn.net/xuemanqianshan/article/details/89305212
向左 xlToLeft - -----1       
向右 xlToRight - ---2       
向上 xlUp - ---------3       
向下 xlDown -------4

jcchiang

回復 11# PJChen
加個"."
   Set Sh = W.Sheets("多")
        Sh.Activate
        i = "A2:E2"
            xcol = Sh.Range(i).Columns.Count  '看幾筆資料
        With W.Sheets("新")
        W.Sheets("新").Activate
       .Range("A4" & xcol).Value = "=" & "多!A3*多!C3" '公式
       .Range("A4" & xcol).Value = .Range("A4" & xcol).Value
        
        End With   
另外Range("A4" & xcol),如果xcol=5,則為Range("A45")
如果是要Range("A4")加上xcol的欄位則改為
.Range("A4").Resize(1, xcol).Value = "=" & " 多!A3*多!C3" '公式
.Range("A4").Resize(1, xcol).Value = .Range("A4").Resize(1, xcol).Value
如果xcol=5,這樣Range("A4")至Range("E4")都會放入公式,但公式的位置會變化
如果要向下放就將Resize(1,xcol)改為Resize(xcol,1)
以上提供參考

jcchiang

回復 13# PJChen
可以執行阿!!
不是有寫:Range("A4" & xcol),如果xcol=5,則為Range("A45")
以你的程式會在Sheets("新")的Range("A45")有個值
如果要向右貼公式改成這樣:
.Range("A4").Resize(1, xcol).Value = "=" & " 多!A3*多!C3" '公式
.Range("A4").Resize(1, xcol).Value = .Range("A4").Resize(1, xcol).Value
但因為公式並沒有將欄位固定,所以公式會變動
Range("A4")= "=" & " 多!A3*多!C3" '公式
Range("B4")= "=" & " 多!B3*多!D3" '公式
Range("C4")= "=" & " 多!C3*多!E3" '公式
以此類推

jcchiang

回復 45# PJChen

妳是要F2欄位恢復顯示"實出效期"嗎??
如果是將程式最後[F2] = ""改為[F2] = "實出效期"

jcchiang

回復 50# PJChen
試試看!!
Sub ex()
Dim x%, i%
Dim xR As Object
For Each xR In Range([b5], [b65535].End(3))
   If xR = "訂單" Or xR = "廠缺" Or xR = "實出數" Then
      For i = 1 To 8
         If xR.Offset(, i) <> 0 Then
            x = Application.WorksheetFunction.Quotient(xR.Offset(, i), [C3])  '計算箱數
            xR.Offset(, i) = xR.Offset(, i) & "=" & vbCrLf & x & "箱+" & xR.Offset(, i) Mod [C3]
         End If
      Next
   End If
Next
End Sub

jcchiang

回復 52# PJChen

For Each xR In Range([b5], [b65535].End(3))
這是讓xR在Range([b5], [b65535].End(3))這個範圍內執行

If xR = "訂單" Or xR = "廠缺" Or xR = "實出數" Then
才是判斷要計算的列

jcchiang

回復 57# PJChen
最近比較忙,沒時間研究

Sub ex()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
For Each a In Range("B:B")
    If a = "林口" Then d(a.Address) = d(a.Address)  '抓林口的位置,廠商自行更換
Next
Range(d.Keys()(0)).Offset(, 5).Resize(d.Count, 10).Select '選擇範圍,請自行加入複製到哪的程式
End Sub

jcchiang

回復 69# PJChen

不是很懂你的意思!!
不是只是將公式放入欄位計算嗎???
後面的程式又改成每個項目單獨執行???

jcchiang

回復 69# PJChen
這個檔案資料都是在計算一些數值,如果是我自己要用,我覺得函數公式寫在儲存格下拉就解決了
因為實際的資料多寡只有你了解,加上部份資料也沒提供(准大提及部份),無法驗證
只能將你所提供的程式整理一下,至於其他所需的部份只能靠你自行增加囉!!

Sub 北區_A_EX()
Dim Sh As Worksheet, xS As Worksheet, xR
Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
Set Sh = Workbooks("全省核銷明細.xlsm").Sheets("北區")
d = xS.[AA3] 'Date
Sh.Activate
'------------ 'A 取B欄年.月
For Each xR In Range([b3], [b65535].End(3)) '向上 End(3) = End(xlup).Row
   If xR >= d Then
      xR.Offset(, -1) = Year(xR) & ".." & Month(xR)     'A 取B欄年.月
      xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8) '北區_K_結餘
      xR.Offset(, 22) = xR.Offset(-1, 22) + xR.Offset(, 5) + xR.Offset(, 8) - xR.Offset(, 6) - xR.Offset(, 7) - xR.Offset(, 21) '北區_X_派板結餘
      '-------------------------R欄無單號
      If xR.Offset(, 16) = "" Then
         xR.Offset(, 3) = "無交貨"
      Else
         xR.Offset(, 3) = xR.Offset(, 18) & xR.Offset(, 17) & xR.Offset(, 16) 'T&S&R
      End If
      '------------------------------供應商
      If xR.Offset(, 1) = "大" Then 'l+g-f+j-n
         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 5) - xR.Offset(, 4) + xR.Offset(, 8) - xR.Offset(, 12)
         xR.Offset(, 11) = xR.Offset(-1, 11) - xR.Offset(, 13)
      Else  '不是"大"應該就是"美"囉
         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 8) - xR.Offset(, 12)
         xR.Offset(, 11) = xR.Offset(-1, 11) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 13)
      End If
      '------------------------------店名
      If xR.Offset(, 2) = "中和" Or xR.Offset(, 2) = "內湖" Or xR.Offset(, 2) = "汐止" Then
         xR.Offset(, 19) = xR
      Else
         xR.Offset(, 19) = xR + 1
      End If
      '-----------------------------盤點差異
      If xR.Offset(, 24) = "" Then
         xR.Offset(, 23) = ""
      Else 'z-x
         xR.Offset(, 23) = xR.Offset(, 24) - xR.Offset(, 22)
      End If
   End If
Next
End Sub