Board logo

標題: 再請教一個VBA語法的問題 [打印本頁]
作者: skyutm    時間: 2012-8-10 11:05     標題: 請教有關VBA的語法！

各位先進大家好！
        小弟是位國小教師，會想要接觸VBA是因為服務的學校並沒有成績計算軟體，所以小弟發憤圖強，自暑假開始研讀有關VBA的書籍
       ，目前已看完Excel VBA超圖解這本書，但是在成績軟體的設計上仍然找無頭緒，所以希望網路上的各位先進可以提供解惑的答案。謝謝指教！
        首先，第一個問題是：我想要在Excel的第一個工作表上設定可以填入資料的空格，資料欄有一個空位是填人數，而所填入的人數則可以控制第二個工作表儲存         
         格的數量，（意思就是基本欄填入20人，那第二個工作表則會列出20個空格以填入學生姓名），請問該利用哪些指令或函數。感謝解惑！
作者: kevin681024    時間: 2012-8-10 14:29

回復 1# skyutm

不知有無回覆到問題
請參考附件
若附件無法下載，請至下列網址下載
http://www.funp.net/664276
    [attach]12085[/attach]
作者: skyutm    時間: 2012-8-10 15:14

哇！真是熱心助人且迅速確實，感謝大大解答，小弟已下載檔案測試無誤。請等我打開編輯器好好研究一下指令。有問題再來請教，先謝啦！
作者: brabus    時間: 2012-8-16 21:11

跟你說喔
這兒的同學是很熱心的
你可以多多提問
我順便可以學習呢
作者: skyutm    時間: 2012-8-16 23:50     標題: 再請教一個VBA語法的問題

各位先進大家好！
       非常感謝大家的協助。小弟尚有第二個問題想要請教。問題如下：
       1.第一個工作表是設定欄、第二個工作表是登記成績欄如果在設定欄填入年段、班級、人數。例如 3年6班15人、成績欄位就會出現30601~30615的15個欄位
       我試了一段時間。數字上只能出現1、無法出現01，目前我已想出如下的語法，但是無法執行，請大家解惑一下，真是感激：
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$b$3" Then
    Dim i As Integer
    For i = 1 To Target.Value
    Worksheets("sheet2").Cells(i + 2, "a") = i
    Next Target.Value
    End If
End Sub
作者: white945    時間: 2012-8-17 00:07

回復 1# skyutm
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Intersect(Target, [B1:B3]) Is Nothing Then Exit Sub
  3. ReDim ar(1 To [B3])
  4. YC = [B1] & Format([B2], "00")
  5. For i = 1 To [B3]
  6.   ar(i) = YC & Format(i, "00")
  7. Next
  8. Sheets(2).[A:A] = ""
  9. Sheets(2).[A1].Resize([B3], 1) = Application.Transpose(ar)
  10. End Sub
複製代碼
作者: skyutm    時間: 2012-8-17 07:19

感謝大大解惑，小弟先去研究一下。再看情形如何。先謝囉！
作者: skyutm    時間: 2012-8-17 18:22

感謝white945大大的回覆，但是有一個小問題，因為[B1:B3]是先填B1所以會出現陣列超出索引範圍的錯誤訊息，我猜可能是因為B3還沒填數字   ReDim ar(1 To [B3])
另外還有
承蒙大家的幫助，我把前面兩位好心人的語法加以修改後，變成下列兩式但是再把它們放在第一個工作表的時候卻會出現問題，想請問論壇的大大，問題是出在哪裡，感謝指教！
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$J$3" Then
        If Sheet2.Range("A1048576").EntireRow.Hidden Then
            Sheet2.Cells.EntireRow.Hidden = False
            Sheet2.Cells.EntireColumn.Hidden = False
        End If
        Sheet2.Range(Sheet2.Range("A" & Target.Value + 3), Sheet2.Range("A3").End(xlDown)).EntireRow.Hidden = True
        Sheet2.Range(Sheet2.Range("W1"), Sheet2.Range("W1").End(xlToRight)).EntireColumn.Hidden = True
    End If
End Sub

Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [J1:J3]) Is Nothing Then Exit Sub
    ReDim ar(1 To [J3])
    YC = [J1] & Format([J2], "00")
    For i = 1 To [J3]
    ar(i) = YC & Format(i, "00")
    Next
    Sheets(2).[A:A] = ""
    Sheets(2).[A3].Resize([J3], 1) = Application.Transpose(ar)
End Sub
作者: white945    時間: 2012-8-17 19:40

回復 9# skyutm
兩個程式碼應該合併
  1. Sub Worksheet_Change(ByVal Target As Range)
  2.     If Intersect(Target, [J1:J3]) Is Nothing Or [J3] = 0 Then Exit Sub
  3.     ReDim ar(1 To [J3])
  4.     YC = [J1] & Format([J2], "00")
  5.     For i = 1 To [J3]
  6.     ar(i) = YC & Format(i, "00")
  7.     Next
  8.     With Sheets(4)
  9.     .Cells.Rows.Hidden = False
  10.     .Cells.Columns.Hidden = False
  11.     .[A:A] = ""
  12.     .[A3].Resize([J3], 1) = Application.Transpose(ar)
  13.     .Range("C1", .Cells(1, .Columns.Count)).EntireColumn.Hidden = True
  14.     .Range(.[A3].Offset([J3], 0), .Cells(Rows.Count, 1)).EntireRow.Hidden = True
  15.     End With
  16. End Sub
複製代碼
作者: skyutm    時間: 2012-8-17 22:16

感謝white945大大的回覆，我先去做一下功課，有問題再來請教，先謝謝了！
作者: skyutm    時間: 2012-8-21 00:19

大家好！又要麻煩各位先進了。小弟的進度遇到困難。問題是我想把期中評量（sheet2）的b3欄位的名字複製到期中成績（sheet3）的b5欄位。語法如下：

Worksheets("期中評量").Range(cells(3, 2), cells(3, 2).End(xlDown)).Copy
    ActiveSheet.Paste Destination:=Worksheets("期中成績").Range(cells(5, 2), cells(5, 2).End(xlDown))

可是一直無法執行，可否幫忙解決，謝謝！
作者: GBKEE    時間: 2012-8-21 05:48

回復 11# skyutm
  1. Worksheets("期中評量").Range(Cells(3, 2), Cells(3, 2).End(xlDown)).Copy Worksheets("期中成績"), Cells(5, 2)
複製代碼
作者: skyutm    時間: 2012-8-21 09:26

感謝版主大大的解惑，小弟先去測試看看。先謝啦！（真是就感心的論壇）



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