返回列表 上一主題 發帖

[發問] 如何將"採購單"內容依序寫入另一個sheet?

[發問] 如何將"採購單"內容依序寫入另一個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

回復 33# guaga
請附檔看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 32# GBKEE
因為A:A  有帶公式 所以不能用這個方法把公式清掉
所以會亂跑的原因 是因為A:A 有帶公式的關係嗎

TOP

本帖最後由 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 30# GBKEE

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

未命名.JPG (54.43 KB)

未命名.JPG

TOP

回復 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"欄
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

可是還是從A欄開始填?

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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?

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 一個缺口的杯子,如果換一個角度看它,它仍然是圓的。
返回列表 上一主題