iT邦幫忙

0

EXCEL的問題5

Sub 從出貨單擷取資料()
Dim i, j As Integer
i = 2
j = 15
If IsFileOpen("F:\材料管理\出貨單.xlsm") Then   
'判斷出貨單檔案是否被打開  若是  跳出IF  執行下面工作  不是  打開出貨單檔案

Else
Workbooks.Open filename:=ThisWorkbook.Path & "\出貨單"
End If
Set d1 = Workbooks("出貨單").Worksheets("sheet0")   
'這個語法是把出貨單的第一工作表  指定給d1  比較節省不用再打那串
Set d2 = Workbooks("需要材料單(加祿到枋山)").Worksheets("sheet0")  
'這是我操作的工作表
For i = 2 To 50
For j = 15 To 150
      If d2.Range("C" & j) = d1.Range("B" & i) Then 讓他去比較
         If Range("f" & j).Value = "" Then   '這個是d2的F欄位的值  若是空的的話
             d2.Range("f" & j).Value = d1.Range("D" & i).Value  
             'd2的f欄位等於d1的d欄位的值
             d2.Range("L" & j).Value = "2019/01/18"  'd2的L欄位插入日期
           Else空
    Range("a" & j + 1, "l" & j + 1).Insert Shift:=xlDown        
    'd2的F欄位如果不是空的  把d2的A的那欄位下面到L的那欄位插入空欄位   但這會多一欄位  不知為何
    d2.Range("f" & j + 1).Value = d1.Range("D" & i).Value  
    'd2的f欄位等於d1的d欄位的值
    d2.Range("L" & j + 1).Value = "2019/01/18"          'd2的L欄位插入日期
    End If
    End If
    Next j
    If d1.Range("b" & i).Value = "" Then
    '判斷出貨單的B欄位是否空的  若是跳出迴圈
       Exit For
    End If
    Next i
    刪除不需要的欄位           '這是我直接把使用的巨集拿來用  目前唯一的方法
                                         '想知道若是高手會如何改   請指教
                                                                  
End Sub

我想知道若是高手 會如何寫 請指教小弟
目前小弟唯一方法是它全部執行好了時候 再去執行刪除不需要的空白欄位

pcw iT邦研究生 4 級 ‧ 2019-01-21 16:08:10 檢舉
重新編輯你的問題,記得使用ithelp的編輯器工具列中的「新增程式碼」按鈕。

1 個回答

0
來杯拿鐵
iT邦新手 4 級 ‧ 2019-01-21 22:31:57
最佳解答

上次做的還沒有做過測式

1.整理變數
變數建議整理起來,放在最前面,長度2~5為佳
不然原始檔改位置,會修改很辛苦。
用全部取代風險很大,原本的I,J太常見,會連語法跟者變。

2.其他
SELECT可以用變數做取代,做的時候我忘記了。
欄位會多一欄,是因為填五列資料,所以插入五列空白行。
如果表單預設一列空白,就要設定-1。
但是沒看到檔案示意圖,部分資訊用猜測的。

Sub ORyI()
'初始化
'shi = shipment(出貨單),sto = stock(材料單)
    Dim shirg, storg As Range
    Set shirg = Range("B2", "B200")
    Set storg = Range("C17", "C250")
    
    Range("F17").Select '表單第一格
    
    '從出貨單B2~B200和材料單C17~250
For Each shi In shirg
  For Each sto In storg
     Range("F10").Formula = "='[出貨單.xlsx]sheet0'!" & shi.Address
           
        '判斷材料單不為空值,材料單有可以出貨貨品
        If (sto.Value = "") Then
        ElseIf (sto.Value = Range("F10").Value) Then
            '從表單f17往下選取第一個空值
                Do While (Selection.Value <> "")
                    Selection.Offset(1, 0).Select
                Loop
            '插入下列F欄填入貨品名,同列L欄填入今天日期
Range(Selection.Offset(-1, 0), Selection.Offset(-1, 6)).Insert Shift:=xlDown
                Selection.Value = sto
                Selection.Offset(0, 6).Value = Format(Now, "yyyy/m/d")
            End If
        Next sto
    Next shi

'出貨單B2~B200和材料單C17~250,可能會有空值需要做除錯
'先將判斷值填入f10,如果f10有重要資料再改別格

太感謝您了 雖然語法不同結果一樣 且不像我寫得那麼長

還要需要修改地方,「插入下列」有斷行,還沒想到辦法。

我要發表回答

立即登入回答