麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何依出貨單的出貨單號，叫出之前存在在清單中的資料?? [打印本頁]

作者: 妤璇 時間: 2014-3-28 14:55 標題: 如何依出貨單的出貨單號，叫出之前存在在清單中的資料??

本帖最後由妤璇於 2014-3-28 14:57 編輯

我的出貨單有設定過帳的巨集，按過帳按鈕，資料就會存在清單的工作表中
我想即然有辦法使用巨集將出貨單的資料轉存在清單中
是不是也有辦法作一個巨集，然後依「出貨單號」將存在清單中的相關資料都叫回來?

請前輩指教!!:)

[attach]17894[/attach]

作者: Hsieh 時間: 2014-3-28 16:16

回復 1# 妤璇
出貨單模組

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ar(), s%
Application.EnableEvents = False
If Target.Address = "$H$5" Then
With Sheets("出貨清單")
For Each a In .Range(.[L3], .[L3].End(xlDown))
If a = Target Then
m = a.Offset(, -2).Value
ReDim Preserve Ar(s)
Ar(s) = Application.Transpose(Application.Transpose(a.Offset(, -11).Resize(, 8).Value))
s = s + 1
End If
Next
End With
Range([A9].Resize(, 8), [A9].Resize(, 8).End(xlDown)).ClearContents
[C3] = m
[A9].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
End If
Application.EnableEvents = True
End Sub

複製代碼

作者: yen956 時間: 2014-3-29 06:09

回復 1# 妤璇
試試看:

'
Private Sub 叫回過帳_Click()
Dim i, blankRow As Integer
Dim 出貨單號1, 出貨單號2 As String
Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("出貨單")
Set sh2 = Sheets("出貨清單")
出貨單號1 = sh1.[H5]
blankRow = sh1.[A65536].End(xlUp).Row + 1
For i = 3 To 65536
出貨單號2 = sh2.Cells(i, 12)
If 出貨單號2 = "" Then
Exit Sub
ElseIf 出貨單號2 = 出貨單號1 Then
sh2.Cells(i, 1).Resize(1, 14).Copy sh1.Cells(blankRow, 1)
blankRow = blankRow + 1
End If
Next
End Sub

複製代碼

物料管理3月28日.7z
http://www.mediafire.com/download/55eqy81iu923mf3/%E7%89%A9%E6%96%99%E7%AE%A1%E7%90%863%E6%9C%8828%E6%97%A5.7z

作者: 妤璇 時間: 2014-3-29 22:35

謝謝二位前輩!!
之前都用巨集，所以花了很久的時間在看，不過還是有很多不懂的
程式運行都ok，感恩呢!!

作者: 妤璇 時間: 2014-4-13 10:38

回復 4# yen956

請問，Private Sub 叫回過帳_Click的Private 是私有程序，當我按指定巨集時，沒看到，要將Private刪掉才可以，要怎麼做才可以在巨集中指定?

程式運行有個問題，叫回過帳後清除資料時，(G欄)、(J欄)、(K欄)、(L欄)、(M欄)、(N欄)沒辦法清除，需手動清除，如此一來寫入的函數也跟著被刪掉了
G欄是對應E欄，J欄、K欄、L欄、M欄、N欄是直接=某些欄位，這幾個是隱藏起來的，程式該如修改?另外工作表有設保護，我將Sheets("出貨單").Unprotect "0523" 寫在程式開始後，將 Sheets("出貨單").protect "0523"寫在程式結束前，但常常會出現錯誤的視窗，不然就是按完巨集後，保護工作表取消了。目前我的方法是新開一張工作表。

作者: yen956 時間: 2014-4-13 14:07

本帖最後由 yen956 於 2014-4-13 14:11 編輯

回復 6# 妤璇
抱歉, 沒考慮到公式回覆的問題,
不過我對公式的了解還是很膚淺, 愛莫能助.
你可拜託H版大試試
又, 新的 Command 按鈕(2000以後)無法指定巨集,
你可複製舊的按鈕, 重新命名, 就可指定巨集,

作者: 妤璇 時間: 2014-4-13 15:53

回復 7# yen956

好的，謝謝你喔!!

作者: 妤璇 時間: 2014-4-15 09:47

回復 2# Hsieh

請問我將程式貼上後，點指定巨集找不到 Worksheet_Change(ByVal Target As Range)
要怎麼使用呢?

作者: GBKEE 時間: 2014-4-15 10:42

回復 9# 妤璇
2# Hsieh 有說

回復 1# 妤璇
出貨單模組

複製代碼

[attach]18019[/attach]

作者: 妤璇 時間: 2014-4-16 00:06

回復 10# GBKEE

感謝你，研究了很久，了解怎麼使用了，從中學到了些，發現我的問題也更多:D

作者: yen956 時間: 2014-4-16 05:55

回復 9# 妤璇

回復 9# 妤璇

請問我將程式貼上後，點指定巨集找不到 Worksheet_Change(ByVal Target As Range)
要怎麼使用呢?

複製代碼

你是想用舊的圖片按鈕, 指定巨集給 Worksheet_Chang(ByVal Target As Range)?
但看不到 Worksheet_Change(ByVal Target As Range) 可以指定?
因為 sub xxxx(ByVal Target As Range) 有參數是無法指定巨集的,

作者: GBKEE 時間: 2014-4-16 07:31

回復 12# yen956

因為 sub xxxx(ByVal Target As Range) 有參數是無法指定巨集的,

複製代碼

這不對的

試試看 sheet1的

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox Target.Address
End Sub

複製代碼

其他模組中

Sub Ex()
Run "sheet1.Worksheet_SelectionChange", Range("A15")
End Sub

複製代碼

作者: 妤璇 時間: 2014-4-16 09:10

回復 13# GBKEE

本來有些概念了，看完之後又亂掉了:'(

請問我的G9:G24有設定函數，執行後會將函數覆蓋掉，有試著從
Range([A9].Resize(, 8), [A9].Resize(, 8).End(xlDown)).ClearContents 中的(,8)改成(,6)
證明我的想法有錯…

作者: GBKEE 時間: 2014-4-16 09:50

回復 14# 妤璇
是要改成如此嗎?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim AR(), s%, T As Integer
Application.EnableEvents = False
If Target.Address = "$H$5" Then
T = 6 '設定欄數 *********
With Sheets("出貨清單")
For Each a In .Range(.[L3], .[L3].End(xlDown))
If a = Target Then
m = a.Offset(, -2).Value
ReDim Preserve AR(s)
AR(s) = Application.Transpose(Application.Transpose(a.Offset(, -11).Resize(, T).Value))
'Ar(s) = Application.Transpose(Application.Transpose(a.Offset(, -11).Resize(, 8).Value))
s = s + 1
End If
Next
End With
Range([A9].Resize(, T), [A9].Resize(, T).End(xlDown)).ClearContents
'Range([A9].Resize(, 8), [A9].Resize(, 8).End(xlDown)).ClearContents
[C3] = m
[A9].Resize(s, T) = Application.Transpose(Application.Transpose(AR))
'[A9].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
End If
Application.EnableEvents = True
End Sub

複製代碼

作者: 妤璇 時間: 2014-4-16 11:23

回復 15# GBKEE

出現小視窗
執行階段錯誤'1004':
無法改變合併儲存格中的一部份。

我在想叫回過帳另外開新的工作表，如此便不會影響出貨單的函數
只是最下方送貨方式的那個框框，文字會變成空白的= =
不知道可不可以幫我修改程式?
謝謝!!

作者: yen956 時間: 2014-4-16 14:14

回復 13# GBKEE
妤璇的原始檔案有不少【圖形按鈕】,
這些【圖形按鈕】都是利用【指定巨集】, 去執行巨集,
故我所說的【指定巨集】, 和你所說的【指定巨集】(Run Marco)
的內涵是不一樣的.
請看下圖就明白了:

作者: 妤璇 時間: 2014-4-16 14:29

回復 16# 妤璇

[attach]18038[/attach]

麻煩你了:)
謝謝!

作者: 妤璇 時間: 2014-4-16 14:37

回復 17# yen956

我之前都是用巨集，不明白 Worksheet_Change 為何無法指定巨集
後來才知道這種的叫事件驅動程式
有個概念了，看你們的討論又暈了
你們太厲害了

作者: GBKEE 時間: 2014-4-17 06:52

回復 17# yen956
轉個彎也可以

Sub Test()
Test1 Range("H5")
End Sub
Sub Test1(ByVal Target As Range)
MsgBox Target.Address
End Sub

複製代碼

回復 18# 妤璇
修改一下,試試看

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ar(), s%
Application.EnableEvents = False
If Target.Address = "$H$5" Then
With Sheets("出貨清單")
For Each a In .Range(.[L3], .[L3].End(xlDown))
If a = Target Then
m = a.Offset(, -2).Value
ReDim Preserve Ar(s)
Ar(s) = Application.Transpose(Application.Transpose(a.Offset(, -11).Resize(, 8).Value))
s = s + 1
End If
Next
End With
If s > 0 Then
[C3] = m
With [A9:H24]
.Cells = ""
.Cells(1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
End With
Else
MsgBox "出貨清單中沒有 " & Target
End If
End If
Application.EnableEvents = True
End Sub

複製代碼

作者: 妤璇 時間: 2014-4-17 08:40

回復 20# GBKEE

可以了，太感謝你了。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)