Board logo

標題: [發問] 如何將"採購單"內容依序寫入另一個sheet? [打印本頁]
作者: guaga    時間: 2013-11-6 18:29     標題: 如何將"採購單"內容依序寫入另一個sheet?

想請問一下各位VBA高手~
最近在研究一個能讓
如何將"採購單"內容依序寫入另一個"庫存記錄"sheet?
(本來想要用附加檔案 會比較好說明 可是附加不上來)

有點像
https://www.youtube.com/watch?v=deRlUjhIHOo   
這種狀況

以下是寫的資料,已經想了好久爬了滿多的文 除了看不懂的之外
我這個新手就是不會寫呀
麻煩各位了

Sub 寫入資料()
If Range("A:A").End(xlDown).Row = 65536 Then
End If
Dim a(10)
a(0) = Range("B5")
a(1) = Range("D5")
a(2) = Range("J5")
a(3) = Range("C6")
a(4) = Range("B9")
a(5) = Range("D9")
a(6) = Range("E9")
a(7) = Range("F9")
a(8) = Range("G9")
a(9) = Range("H9")
a(10) = Range("I9")


Sheets("庫存記錄").Select

End Sub
作者: Kubi    時間: 2013-11-6 18:55

Sub test()
    Dim arr
    Sheets("採購單").Select
    arr = Array([B5], [D5], [J5], [C6], [B9], [D9], [E9], [F9], [G9], [H9], [I9])
    Sheets("庫存記錄").Select
    Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
End Sub
作者: stillfish00    時間: 2013-11-6 19:35

回復 1# guaga
允許上傳的檔案附件類型為:chm, pdf, zip, rar, tar, gz, bzip2, gif, jpg, jpeg, png。
所以，壓縮後再上傳吧
作者: guaga    時間: 2013-11-7 08:48

回復 2# Kubi
你好 我試過這樣的方法 不過 不行耶
已附上檔案
作者: guaga    時間: 2013-11-7 08:48

回復 3# stillfish00


    你好,我已經付上檔案了 麻煩你了
作者: guaga    時間: 2013-11-7 09:05

回復 2# Kubi

我已經弄好了 非常謝謝你  是我自己把欄位填錯所以顯示不出來
不過"品名"的地方 有資料,卻顯示不出來耶

Sub test()
    Dim arr
    Sheets("採購單").Select
    arr = Array([D5], [J5], [B6], [C10], [D10], [E10], [F10], [G10], [H10], [I10], [J10])
    Sheets("採購記錄").Select
    Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
End Sub
作者: GBKEE    時間: 2013-11-7 16:22

回復 6# guaga
  1. Option Explicit
  2. Sub test()
  3.     Dim arr, i As Integer
  4.     Sheets("採購記錄").UsedRange.Offset(1).Clear
  5.     With Sheets("採購單")
  6.         For i = 10 To .[B30].End(xlUp).Row
  7.             arr = Array(.[B5], .[D5], .[J5], .[B6], .Cells(i, "B"), .Cells(i, "D"), .Cells(i, "E"), .Cells(i, "F"), .Cells(i, "G"), .Cells(i, "H"), .Cells(i, "I"), .Cells(i, "J"))
  8.             Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
  9.         Next
  10.     End With
  11. End Sub
複製代碼
作者: guaga    時間: 2013-11-7 16:35

回復 7# GBKEE

版主你好
這樣使用上沒有問題
可是輸入下筆資料時能之前的資料就會不見 有解嗎
作者: GBKEE    時間: 2013-11-8 06:41

回復 8# guaga
這行程式碼駐解掉
  1. 'Sheets("採購記錄").UsedRange.Offset(1).Clear
複製代碼
作者: guaga    時間: 2013-11-8 07:57

回復 9# GBKEE
謝謝版主幫我解決這個問題
可以順便請問一下 一開始我寫的那個程式 為甚麼會行不通嗎?
作者: GBKEE    時間: 2013-11-8 08:12

回復 10# guaga
4#的檔案嗎?

[attach]16629[/attach]
作者: c_c_lai    時間: 2013-11-8 08:16

本帖最後由 c_c_lai 於 2013-11-8 08:19 編輯

回復 7# GBKEE
請教您要如何處理 (程式 #7)，如圖：
[attach]16628[/attach]
1. 採購日期、到貨日期 於匯入至 "採購記錄"，如何能同時匯入 YYYYMMDD 型態；
2. B6:C6 兩欄 是 完整的 "廠商" 組合，要如同在廠商欄匯入時，帶入值能為 "A001 倫飛" (如圖)；
3. "備註" (同時跨越 J、K、L 三欄) 資料為何無法匯入呢？
不好意思打攪您，在此先向您說聲謝謝。
作者: GBKEE    時間: 2013-11-8 08:29

本帖最後由 GBKEE 於 2013-11-8 08:33 編輯

回復 12# c_c_lai
  1. Option Base 陳述式
  2. 在模組層次中用來宣告陣列索引的預設下限。
  3. 語法
  4. Option Base {0 | 1}
  5. 請注意
  6. 若預設的下限值為 0，則 Option Base 陳述式是不需要的。若需要使用時，此陳述式必須出現在模組中，並且在任何程序之前。Option Base 僅能在模組裏出現一次，而且必須在含有維數的陣列宣告之前。
  7. 附註 在 Dim、Private、Public、ReDim 和 Static 陳述式中，To 子句提供較具彈性的方法，來控制陣列索引的範圍。然而，如果不使用 To 子句來明確的設定下限，則可用 Option Base 來改變預設值的下限為 1。Array 函數所建立的陣列預設下限必為零，不受 Option Base 所影響。
  8. Option Base 陳述式只影響它所在的模組裏之陣列的下限。
複製代碼
  1. Option Explicit
  2. Sub test()
  3.     Dim arr, i As Integer
  4.     Sheets("採購記錄").UsedRange.Offset(1).Clear
  5.     With Sheets("採購單")
  6.         For i = 10 To .[B30].End(xlUp).Row
  7.             arr = Array(.[B5], .[D5].Text, .[J5], .[B6] & .[c6], .Cells(i, "B"), .Cells(i, "D"), .Cells(i, "E"), .Cells(i, "F"), .Cells(i, "G"), .Cells(i, "H"), .Cells(i, "I"), .Cells(i, "J"))
  8.             Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr) + 1) = arr
  9.         Next
  10.     End With
  11. End Sub
複製代碼
作者: guaga    時間: 2013-11-8 08:46

回復 12# c_c_lai


1. 採購日期、到貨日期 於匯入至 "採購記錄"，如何能同時匯入 YYYYMMDD 型態
我只知道 可以在你選取的儲存格 /右鍵/儲存格格式/數值-日期
選擇即可
作者: c_c_lai    時間: 2013-11-8 09:03

回復 13# GBKEE
回復 14# guaga
應用 .[D5].Text (採購日期)、  .[J5].Text (到貨日期) 已經OK，
但是 "備註" 資料的匯入還是無法帶入， 改成 .Cells(i, "J").Text
結果一樣，麻煩您了，謝謝！
作者: GBKEE    時間: 2013-11-8 09:13

回復 15# c_c_lai
  1. Option Explicit
  2. Sub test()
  3.     Dim arr, i As Integer
  4.     Sheets("採購記錄").UsedRange.Offset(1).Clear
  5.     With Sheets("採購單")
  6.         For i = 10 To .[B30].End(xlUp).Row
  7.             arr = Array(.[B5], .[D5].Text, .[J5], .[B6] & .[c6], .Cells(i, "B"), .Cells(i, "D"), .Cells(i, "E"), .Cells(i, "F"), .Cells(i, "G"), .Cells
  8. (i, "H"), .Cells(i, "I"), .Cells(i, "J"))
  9. '******* .Cells(i, "B")  這不也是合併BC兩欄 ****************
  10.             Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr) + 1) = arr
  11.                        '*************UBound(arr) + 1 應可顯示 .Cells(i, "J")的資料  ********************
  12.         Next
  13.     End With
  14. End Sub
複製代碼
  1. Option Explicit
  2. Option Base 1
  3. Sub Ex()
  4.     Dim AR, S
  5.     S = "S,S,S"
  6.     S = Split(S, ",")
  7.     MsgBox UBound(S)
  8.     MsgBox LBound(S)
  9.     AR = Array(5, 6)
  10.     MsgBox UBound(AR)
  11.     MsgBox LBound(AR)
  12. End Sub
複製代碼
作者: c_c_lai    時間: 2013-11-8 09:21

回復 16# GBKEE
太感激您了，我怎麼會沒想到 UBound(arr) 的問題，
發覺我霎那間智慧未能同時成長，謝謝呦！
作者: c_c_lai    時間: 2013-11-8 10:19

回復 13# GBKEE
我完全了解 #13 所說的 Option Base 正確使用方法了，
如果不宣告，Array 陣列是從 0 開始起算，所以 UBound(arr) 值會為 11，
反之、宣告 Option Base 1，則 Array 是從 1 開始起算，因此 UBound(arr) 值會為 12。
感謝您仔細地說明！
作者: GBKEE    時間: 2013-11-9 09:46

回復 18# c_c_lai
  1. Option Explicit
  2. Option Base 0   '的例外
  3. Sub Ex()
  4.     Dim Ar(5 To 10), Br()
  5.     MsgBox UBound(Ar)
  6.     MsgBox LBound(Ar)
  7.     Br = [b3:c5].Value    '以儲存格為陣列
  8.     MsgBox UBound(Br)
  9.     MsgBox LBound(Br)
  10. End Sub
複製代碼
作者: c_c_lai    時間: 2013-11-9 10:39

回復 19# GBKEE
無論是 Option Base 1 或者是 Option Base 0，以儲存格為陣列條件
下的範例測試竟然會 Ignore Option Base 的宣告， 謝謝您的指導！
[attach]16651[/attach]
作者: hu0318s    時間: 2013-11-13 22:25

報歉板主我是新手可以請教一下對這行程式不太了解  是到Sheets("採購記錄").然後從最後一列然後在arr內的內容貼上嗎Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
作者: GBKEE    時間: 2013-11-14 07:00

回復 21# hu0318s
Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr

[A65536].End(3).Row-> 由A65536往上到第1個有資料的列號(.Row)
Sheets("採購記錄").Cells([A65536].End(3).Row + 1, 1)-> Sheets("採購記錄").Cells(列號,欄號)   

Resize 方法:  調整指定的範圍。傳回 Range 物件，該物件代表調整後的範圍。
UBound 函數 傳回 Long值，表示指定陣列某維最大可使用的陣列索引 (等同計算陣列某維元素的數量)
例 Sheets("採購記錄").Cells(1,1).Resize(1,10)->調整後的範圍: A1:J1=arr
    Sheets("採購記錄").Cells(3,2).Resize(1,10)->調整後的範圍: B3:K3=arr
作者: guaga    時間: 2013-11-25 18:59

回復 7# GBKEE
不好意思 今天在做別的東西的時候發現
我用同樣的表格 改了幾個字 就完全不理我'了?
    Option Explicit
    Sub test()
        Dim arr, i As Integer
        Sheets("訂購記錄").UsedRange.Offset(1).Clear
        With Sheets("訂購單")
            For i = 8 To .[B16].End(xlUp).Row
                arr = Array(.[B5], .[D5], .[J5], .[B6], .Cells(i, "B"), .Cells(i, "A"), .Cells(i, "E"), .Cells(i, "F"), .Cells(i, "G"), .Cells(i, "H"), .Cells(i, "I"), .Cells(i, "J"))
                Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
            Next
        End With
    End Sub
作者: GBKEE    時間: 2013-11-25 19:34

回復 23# guaga
  1. With Sheets("訂購單")
  2.              MsgBox  .[B16].End(xlUp).Row  '如果<8 For : Not Work  
  3.             For i = 8 To .[B16].End(xlUp).Row
複製代碼
如不是附檔看看
作者: guaga    時間: 2013-11-26 11:54

回復 24# GBKEE

[attach]16874[/attach]
已附上檔案
麻煩版主解決了:dizzy:
作者: GBKEE    時間: 2013-11-26 12:30

回復 25# guaga
請在你附檔上試試看
  1. Option Explicit
  2.     Sub TEST1()
  3.         Dim arr, i As Integer
  4.         With Sheets("訂購單")
  5.         MsgBox .[B15].End(xlUp).Row                             '因A欄,B欄 是合併的儲存格,B欄是空白的
  6.         MsgBox .[A17].End(xlUp).Row                             '如圖示 .[A10:A16] 都有資料 =>10
  7.             For i = 10 To Application.CountA(.[A10:A16]) + 9    'CountA : 計算[A10:A16]的資料數(資料一定要是連續的)
  8.                 arr = Array(.[L4], .[N4], .[L7].Text, .Cells(i, "A"), .Cells(i, "C"), .Cells(i, "E"), .Cells(i, "H"), .Cells(i, "I"), .Cells(i, "J"), .Cells(i, "L"))
  9.                     '.[L7]資料日期,是數字,.[L7].Text 可傳回日期的格式
  10.                 Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
  11.             Next
  12.         End With
  13.     End Sub
複製代碼
[attach]16875[/attach]
作者: guaga    時間: 2013-11-26 14:10

回復 26# GBKEE

MsgBox .[B15].End(xlUp).Row      這段 加進去的話 跑起來只會顯示一段
後來我改成

    Option Explicit
        Sub TEST1()
            Dim arr, i As Integer
            With Sheets("訂購單")
                For i = 10 To Application.CountA(.[A10:A16]) + 9
                    arr = Array(.[L4], .[N4], .[L7].Text, .Cells(i, "A"), .Cells(i, "C"), .Cells(i, "E"), .Cells(i, "H"), .Cells(i, "I"), .Cells(i, "J"), .Cells(i, "L"))
                        
                    Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr
                Next
            End With
        End Sub

不過備註欄跑不出來耶  是不是也要標柱 text?
作者: GBKEE    時間: 2013-11-26 15:13

回復 27# guaga
例 AR(0 TO 10) 這陣列共有11個元素 :  陣列下限索引值=0  , 陣列上限索引值=10  
UBound(arr): UBound傳回陣列上限索引值
  1. Option Explicit
  2. Sub TEST1()
  3.     Dim arr, i As Integer
  4.     With Sheets("訂購單")
  5.         For i = 10 To Application.CountA(.[A10:A16]) + 9
  6.             arr = Array(.[L4], .[N4], .[L7].Text, .Cells(i, "A"), .Cells(i, "C"), .Cells(i, "E"), .Cells(i, "H"), .Cells(i, "I"), "=RC[-1]*RC[-2]", .Cells(i, "J"), .Cells(i, "L"))
  7.             Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr) + 1) = arr
  8.         Next
  9.     End With
  10. End Sub
複製代碼
作者: guaga    時間: 2013-11-27 17:07

回復 28# GBKEE
我了解了  真的非常謝謝版主
不過還有個問題想請教一下  如果要在  sheet 訂購記錄  那邊多加一欄
改成
Sheets("訂購記錄").Cells([B65536].End(3).Row + 1, 1).Resize(1, UBound(arr)) = arr

可是還是從A欄開始填?
作者: GBKEE    時間: 2013-11-27 17:24

回復 29# guaga
sheet 訂購記錄,那邊多加一欄:  這arr是你依Sheets("訂購記錄")欄位內容所指定的元素
你是要修正 這arr, 配合這 [多加一欄]
原本這arr = Array(.[L4], .[N4], .[L7].Text, .Cells(i, "A"), .Cells(i, "C"), .Cells(i, "E"), .Cells(i, "H"), .Cells(i, "I"), "=RC[-1]*RC[-2]", .Cells(i, "J"), .Cells(i, "L"))
Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 1).Resize(1, UBound(arr)+1) = arr

可是還是從A欄開始填? : Cells([A65536].End(3).Row + 1, 1) => Cells(列數, 欄數):   列數->數字 ,欄數->數字,字串-> 1="A"欄 ,2="B"欄 ,27="AA"欄
作者: guaga    時間: 2013-11-28 13:20

回復 30# GBKEE

感謝版主,我改成
Sheets("訂購記錄").Cells([A65536].End(3).Row + 1, 2).Resize(1, UBound(arr) + 1) = arr
不過這個有時候都會跳到 A1048576的儲存格去
有什麼辦法解決?
作者: GBKEE    時間: 2013-11-28 16:12

本帖最後由 GBKEE 於 2013-11-28 16:13 編輯

回復 31# guaga
可能是Sheets("訂購記錄")A欄中的儲存格有完全是空白字元的字串(不會顯示,所以看不見)
執行一次這程序,可消除空白的字元

LTrim、RTrim 與 Trim 函數
傳回一個沒有前頭空白 (LTrim)、後面空白 (RTrim) 或前後均無空白的Variant (String)，其中所含為給定的字串
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Range
  4.     With Sheets("訂購記錄")
  5.         For Each E In .Range("A:A").SpecialCells(xlCellTypeConstants, 3)
  6.             E = Trim(E)
  7.         Next
  8.         MsgBox Range("A65536").End(xlUp).Address
  9.    End With
  10. End Sub
複製代碼
作者: guaga    時間: 2013-11-29 10:25

回復 32# GBKEE
因為A:A  有帶公式 所以不能用這個方法把公式清掉
所以會亂跑的原因 是因為A:A 有帶公式的關係嗎
作者: GBKEE    時間: 2013-11-29 10:28

回復 33# guaga
請附檔看看



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