兩個工作表的資料比較

excel vba

cyris 2021-03-02 10:32:14 ‧ 1352 瀏覽

分享至

有兩個工作表, dailystock.xlsm 和 dailyupdate.xlsm 兩個工作簿

dailystock是每天早上自動更新庫存數量, 我需要每天早上上班按下update 按鍵,把相對的庫存數量和今天日期貼在dailyupdate.xlsm內

目前只寫了日期部份, 庫存更新還沒想到, 有沒有大大能幫忙,謝謝

日期部份

Option Explicit

Sub update_Click()

Dim i As Integer
Dim d As String
d = Date

    For i = 1 To 999
    If Cells(2, i) <> "" Then
      i = i
      Else
       Cells(2, i).Value = d
    Exit For
    End If
        Next
End Sub

koro_michael iT邦新手 2 級 ‧ 2021-03-02 12:50:57 檢舉

居然是VB，多久沒看到過了

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

2 個回答

koro_michael

iT邦新手 2 級 ‧ 2021-03-02 14:40:21

最佳解答

VB語法真的挺囉唆的，附上範例檔案，麻煩給個最佳解答吧

Function data() As Collection
    Dim list As New Collection
    Dim xlBook As Excel.Workbook
    Dim sheet As Excel.Worksheet
    
    Set xlBook = Workbooks.Open("dailystock.xlsm")
    Set sheet = xlBook.Worksheets("table1")
    
    For i = 2 To 999
        If sheet.Cells(i, 1) <> "" Then
            Dim code As String
            Dim count As String
            
            code = sheet.Cells(i, 1)
            count = sheet.Cells(i, 2)
            
            Dim strArr(2) As String
            strArr(0) = code
            strArr(1) = count
            
            list.Add strArr
        Else
            Exit For
        End If
    Next i
    
    xlBook.Close
    
    Set data = list
End Function

Sub update_Click()
    Dim date_string As String
    date_string = Date
    
    Dim target As Integer
    
    For i = 2 To 999
        If Cells(1, i) = "" Then
            target = i
            Cells(1, i) = date_string
            Exit For
        End If
    Next i
    
    Dim list As Collection
    Set list = data()
    
    Dim Item As Variant
    For Each Item In list
        For j = 2 To 999
            If Cells(j, 1) <> "" Then
                If Cells(j, 1) = Item(0) Then
                    Cells(j, target) = Item(1)
                    Exit For
                End If
            Else
                Cells(j, 1) = Item(0)
                Cells(j, target) = Item(1)
                Exit For
            End If
        Next j
    Next Item
End Sub

範例連結

回應 22
分享
檢舉

看更多先前的回應...收起先前的回應...

cyris iT邦新手 5 級 ‧ 2021-03-02 15:30:25 檢舉

首先謝謝大大的編碼

Dim list As Collection
    Set list = data()
    
    For Each Item In list
        For j = 2 To 999
            If Cells(j, 1) <> "" Then
                If Cells(j, 1) = Item(0) Then
                    Cells(j, target) = Item(1)
                    Exit For
                End If
            Else
                Cells(j, 1) = Item(0)
                Cells(j, target) = Item(1)
                Exit For
            End If
        Next j
    Next Item

excel 說item 沒有定義

koro_michael iT邦新手 2 級 ‧ 2021-03-02 15:37:11 檢舉

刪除內容

如果是沒有定義，加上一行宣告就好了

koro_michael iT邦新手 2 級 ‧ 2021-03-02 15:38:22 檢舉

在 For 迴圈上面加上

Dim Item As Variant

cyris iT邦新手 5 級 ‧ 2021-03-02 16:50:53 檢舉

請問如果要貼上的不是第一列而是BD3列可以怎麼做?

koro_michael iT邦新手 2 級 ‧ 2021-03-02 16:59:12 檢舉

如果 BD3 是日期那一條

    For i = 57 To 999
        If Cells(3, i) = "" Then
            target = i
            Cells(3, i) = date_string
            Exit For
        End If
    Next i

    For Each Item In list
        For j = 4 To 999
            If Cells(j, 56) <> "" Then
                If Cells(j, 56) = Item(0) Then
                    Cells(j, target) = Item(1)
                    Exit For
                End If
            Else
                Cells(j, 56) = Item(0)
                Cells(j, target) = Item(1)
                Exit For
            End If
        Next j
    Next Item

koro_michael iT邦新手 2 級 ‧ 2021-03-02 17:07:45 檢舉

cyris iT邦新手 5 級 ‧ 2021-03-02 17:59:32 檢舉

這個我嘗試了, 有一個問題是它只會把來源檔的資料貼上目標excel檔內, 不能自動找出相對code然後在那貼上數量

koro_michael iT邦新手 2 級 ‧ 2021-03-02 18:13:20 檢舉

庫存長這樣

存在一些Code

點下按鈕後會比對Code去貼數量，可以跟第一張圖比對，數字都是符合的

koro_michael iT邦新手 2 級 ‧ 2021-03-02 18:14:58 檢舉

我自己跑是會比對貼數量的，就不知道我理解的是不是你想要表達的

PS: 因為起始點設定為 BD3 ，所以 Code 要列在 BD3 以下(BD4~BDXXX)，巨集會自動比對後填入數字

cyris iT邦新手 5 級 ‧ 2021-03-03 09:59:18 檢舉

我把一些資料放上來再說明,可能是我說明的不夠好, 不好意思

每天早上的7點, book1 會自動更新第11列的庫存
我而要每天在book2 按下update,把book1 的庫存數, 填上book2 的第9列,如此類推,book2 的1,9 是今天的日期, 資料比對是以第6列的stock code進行

還有一個問題, book1 的stock code有很多, 只要book2 有的項目,還在研究中
謝謝

koro_michael iT邦新手 2 級 ‧ 2021-03-03 15:34:12 檢舉

好喔，我等等按照你這張圖片的格式修改一下

koro_michael iT邦新手 2 級 ‧ 2021-03-03 15:52:40 檢舉

按照你給的格式調整了一下，也加入了只放 book2 有的項目

一樣附上範例 EXCEL

點我下載範例

Function data() As Collection
    Dim list As New Collection
    Dim xlBook As Excel.Workbook
    Dim sheet As Excel.Worksheet
    
    Set xlBook = Workbooks.Open("dailystock.xlsm")
    Set sheet = xlBook.Worksheets("table1")
    
    For i = 2 To 999
        If sheet.Cells(i, 6) <> "" Then
            Dim code As String
            Dim count As String
            
            ' book1 stock code 的位置
            code = sheet.Cells(i, 6)
            ' book1 庫存數量的位置
            count = sheet.Cells(i, 11)
            
            Dim strArr(2) As String
            strArr(0) = code
            strArr(1) = count
            
            list.Add strArr
        Else
            Exit For
        End If
    Next i
    
    xlBook.Close
    
    Set data = list
End Function

Sub update_Click()
    Dim date_string As String
    date_string = Date
    
    Dim target As Integer
    
    ' 8 = book2 日期開始的位置
    For i = 8 To 999
        If Cells(1, i) = "" Then
            target = i
            Cells(1, i) = date_string
            Exit For
        End If
    Next i
    
    Dim list As Collection
    Set list = data()
    
    Dim Item As Variant
    For Each Item In list
        For j = 2 To 999
            ' 6 = book2 stock code 的位置
            If Cells(j, 6) <> "" Then
                If Cells(j, 6) = Item(0) Then
                    Cells(j, target) = Item(1)
                    Exit For
                End If
            End If
        Next j
    Next Item
End Sub

cyris iT邦新手 5 級 ‧ 2021-03-03 17:00:32 檢舉

好奇怪, 我只能出現日期, 資料是空的~

cyris iT邦新手 5 級 ‧ 2021-03-03 18:00:13 檢舉

我把檔案的名子改了, 他說找不到, 但在code裏面己經改成他的名稱了....

koro_michael iT邦新手 2 級 ‧ 2021-03-03 23:51:26 檢舉

table1 是工作表的名稱，記得也要換

cyris iT邦新手 5 級 ‧ 2021-03-04 09:57:00 檢舉

今天不知為何可以了~電腦怪怪的
另外想問一下, 原本的dailystock 的sheet1 是有他本來的名字的, 如果一開始把它先存在, 然後marco成功後把sheet1 的名字改回去可以嗎?

koro_michael iT邦新手 2 級 ‧ 2021-03-04 10:08:05 檢舉

Set sheet = xlBook.Worksheets("table1")

你直接把 table1 改成原本 dailystock 的名字就好，比如 "工作表1" "庫存"...等等

cyris iT邦新手 5 級 ‧ 2021-03-04 10:31:22 檢舉

如果我用worksheet(1)不知道可不可以

koro_michael iT邦新手 2 級 ‧ 2021-03-04 10:38:39 檢舉

基本上可以

cyris iT邦新手 5 級 ‧ 2021-03-04 10:51:54 檢舉

很奇怪, 變了worksheet(1)就不行了

Set sheet = xlBook.Worksheets(1)

koro_michael iT邦新手 2 級 ‧ 2021-03-04 11:13:49 檢舉

我沒有你當下真正的兩份檔案，沒辦法解答你的問題

畢竟我提供的程式碼都是依照你給的範例來運作的

所以假如你沒有辦法修改程式的話，只能將真正的檔案結構傳給我（內容可以用假資料）

我直接幫你修改

cyris iT邦新手 5 級 ‧ 2021-03-04 13:13:32 檢舉

沒事, 我還要謝謝大大的幫忙,謝謝

登入發表回應

rogeryao

iT邦超人 8 級 ‧ 2021-03-02 16:54:49

Private Sub update_Click()
Dim MyFilePath As String
MyFilePath = ActiveWorkbook.Path
Dim Source As Workbook
Set Source = Workbooks.Open(MyFilePath & "\" & "dailystock.xlsm")
Dim Target As Workbook
Set Target = Workbooks.Open(MyFilePath & "\" & "dailyupdate.xlsm")
Dim SearchStr As String
Dim Source_RowNo As Integer
Dim Target_RowNo As Integer
' Target 指定日期的位置
Dim Target_x_Mark As Integer
' 設定 Target 起始位置
Dim Target_Org As String
Dim Target_x_Org As Integer
Dim Target_y_Org As Integer
Target_Org = "BD3"
Target_x_Org = 56
Target_y_Org = 3
'
Target.Sheets("工作表1").Cells(Target_y_Org, Target_x_Org) = "code"
'
Source_RowNo = Source.Sheets("工作表1").Range("A1").End(xlDown).Row
If Target.Sheets("工作表1").Cells(Target_y_Org + 1, Target_x_Org) = "" Then
  Target_RowNo = Target_y_Org
Else
  Target_RowNo = Target.Sheets("工作表1").Range(Target_Org).End(xlDown).Row
End If
' 寫入 Target code 欄位:重複的 code 不寫入
For Source_y = 2 To Source_RowNo
  SearchStr = Source.Sheets("工作表1").Cells(Source_y, 1)
  If (WorksheetFunction.CountIf(Target.Sheets("工作表1").Range(Cells(Target_y_Org + 1, Target_x_Org), Cells(Target_RowNo, Target_x_Org)), SearchStr) = 0) Then
    Target.Sheets("工作表1").Cells(Target_RowNo + 1, Target_x_Org) = SearchStr
    Target_RowNo = Target.Sheets("工作表1").Range(Target_Org).End(xlDown).Row
  End If
Next Source_y

' 寫入 Target date 欄位:重複的 date 不寫入
SearchStr = Date
If Target.Sheets("工作表1").Cells(Target_y_Org, Target_x_Org + 1) = "" Then
  Target_ColumnNo = Target_x_Org
  Target.Sheets("工作表1").Cells(Target_y_Org, Target_ColumnNo + 1) = SearchStr
  Target_x_Mark = Target_ColumnNo + 1
Else
  Target_ColumnNo = Target.Sheets("工作表1").Range(Target_Org).End(xlToRight).Column
  If (WorksheetFunction.CountIf(Target.Sheets("工作表1").Range(Cells(Target_y_Org, Target_x_Org + 1), Cells(Target_y_Org, Target_ColumnNo)), SearchStr) = 0) Then
    Target.Sheets("工作表1").Cells(Target_y_Org, Target_ColumnNo + 1) = SearchStr
    Target_x_Mark = Target_ColumnNo + 1
  Else
    For Target_x = Target_x_Org + 1 To Target_ColumnNo
      If Target.Sheets("工作表1").Cells(Target_y_Org, Target_x) = SearchStr Then
        Target_x_Mark = Target_x
        Exit For
      End If
    Next Target_x
  End If
End If

' 寫入 Target 數量 欄位
For Source_y = 2 To Source_RowNo
  For Target_y = Target_y_Org + 1 To Target_RowNo
    If Target.Sheets("工作表1").Cells(Target_y, Target_x_Org) = Source.Sheets("工作表1").Cells(Source_y, 1) Then
      Target.Sheets("工作表1").Cells(Target_y, Target_x_Mark) = Source.Sheets("工作表1").Cells(Source_y, 2)
      Exit For
    End If
  Next Target_y
Next Source_y

End Sub