willy1205

回復 20# GBKEE

剛好像沒存好巨集再放一次 ex.zip (47.55 KB)

下載次數: 5

2014-4-11 14:31

怕又沒存好 我把巨集複製再筆記本

是的，判斷主辦或協辦的名子是哪個就把資料導入到那個人的sheet裡面，
我是寫If Worksheets("sheet1").Range("B8").Value = "甲君" Then 利用儲存格上的名子判斷輸入的資料該去甲君的sheet還是其他人的
所以有70個判斷式...

GBKEE

回復 21# willy1205

所以有70個判斷式...

不需如此麻煩

1. Sub RoundedRectangle1_Click()
   
2.     Dim NewRow As Integer, E As Range, Sh As Worksheet
   
3.     Set Sh = Worksheets("Sheet1")  '變數指定為工作表 **下面的程式碼如有更改 工作表 **改這變數可省麻煩
   
4.     NewRow = Sh.Range("J34").Value
   
5.    ' Worksheets("sheet1").Range("B8").Value  '管他是 甲君,乙君,丙君 只要這工作表(名稱)有在活頁簿中,
   
6.     For Each E In Sh.Range("B8,B10")  '導入B8,B10 的儲存格
   
7.         With Worksheets(E.Value)   'E.Value 的工作表
   
8.             .Cells(NewRow, 1) = Sh.Range("C5")
   
9.             .Cells(NewRow, 2) = Sh.Range("C6").Value
   
10.             .Cells(NewRow, 3) = Sh.Range("I12").Value
    
11.             .Cells(NewRow, 4) = Sh.Range("I13").Value
    
12.             .Cells(NewRow, 6) = Sh.Range("G22").Value
    
13.             If E.Address = "$B$8" Then   '主辦
    
14.                 .Cells(NewRow, 7) = Sh.Range("H30")
    
15.                 Sh.Range("J34") = NewRow
    
16.             Else                                  '協辦
    
17.                 .Cells(NewRow, 7) = Sh.Range("H32")
    
18.                 Sh.Range("J35") = NewRow
    
19.             End If
    
20.         End With
    
21.     Next
    
22.     MsgBox "New Data added", vbOKOnly, "Data"
    
23. End Sub

複製代碼

willy1205

回復 22# GBKEE


    謝謝版主，我再試試看

還有如果初學者想找書自修VBA的話有推薦的嗎??
目前都只是網路找PDF書籍自己慢慢摸...有點難懂

GBKEE

回復 23# willy1205
多看看程式區回覆的程式碼,不懂的複製下來,看看vba 視窗的說明.
再不明瞭,可發問,光看書不如無書

willy1205

回復 24# GBKEE


    okok 謝謝版主

opelwang

恛噎BA的用法.

willy1205

回復 22# GBKEE


    版主有個問題，就是乙君是協辦，所以乙君抓的金額應該是H32，只有這個會跟甲君不同，我自己剛也沒發現到，
由於他是協辦所以他的資料要在第27行開始，但我按了導入資料以後J35變成7，所以乙君資料也出現在第7行，
這要怎麼修改才可以??

willy1205

回復 22# GBKEE


    謝謝版主 資料抓取沒錯，可是J35還是變成7，乙君的資料還是出現在第7行而不是第27行耶

GBKEE

回復 28# willy1205

1. Option Explicit
   
2. Sub RoundedRectangle1_Click()
   
3.     Dim NewRow As Integer, E As Range, Sh As Worksheet
   
4.     Set Sh = Worksheets("Sheet1")  '變數指定為工作表 **下面的程式碼如有更改 工作表 **改這變數可省麻煩
   
5.    'Worksheets("sheet1").Range("B8").Value  '管他是 甲君,乙君,丙君 只要這工作表(名稱)有在活頁簿中,
   
6.     For Each E In Sh.Range("B8,B10")  '導入B8,B10 的儲存格
   
7.         '判斷 主辦,協辦 的列號
   
8.         If E.Address = "$B$8" Then   '主辦
   
9.             NewRow = Sh.Range("J34").Value
   
10.         Else                         '協辦
    
11.             NewRow = Sh.Range("J35").Value
    
12.         End If
    
13.         
    
14.         With Worksheets(E.Value)   'E.Value 的工作表
    
15.             .Cells(NewRow, 1) = Sh.Range("C5")
    
16.             .Cells(NewRow, 2) = Sh.Range("C6").Value
    
17.             .Cells(NewRow, 3) = Sh.Range("I12").Value
    
18.             .Cells(NewRow, 4) = Sh.Range("I13").Value
    
19.             .Cells(NewRow, 6) = Sh.Range("G22").Value
    
20.             '判斷主辦,協辦 要改變的位置列號
    
21.             If E.Address = "$B$8" Then   '主辦
    
22.                 .Cells(NewRow, 7) = Sh.Range("H30")
    
23.             Else                          '協辦
    
24.                 .Cells(NewRow, 7) = Sh.Range("H32")
    
25.             End If
    
26.         End With
    
27.     Next
    
28.     MsgBox "New Data added", vbOKOnly, "Data"
    
29. End Sub

複製代碼

willy1205

回復 29# GBKEE


    了解 謝謝版主