標題: 請問我要如何改vba [打印本頁]

---

作者: JEAN    時間: 2013-7-16 16:20     標題: 請問我要如何改vba

以下是原來的vba:

Sub 領用單寫入()
Dim Ar()
With Sheets("領用單")
If Cells(3, 2) = "" Then
MsgBox "請輸入部門"
Else
If Cells(4, 2) = "" Then
MsgBox "請輸入領用人名字"
Else
If Cells(3, 8) = "" Then
MsgBox "請輸入日期"
Else
If Application.CountA(.[A6:A16]) > 0 Then
For Each a In .[A6:A16].SpecialCells(xlCellTypeConstants)
  ReDim Preserve Ar(S)
  Ar(S) = Array(.[B3].Value, .[B4].Value, .[H3].Value, a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value, a.Offset(, 7).Value)
  S = S + 1
Next
r = Application.CountA(Sheets("領用記錄明細表").[A:A]) + 2
r = Application.CountA(Sheets("領用記錄明細表 (2)").[A:A]) + 2
Sheets("領用記錄明細表").Cells(r, 1).Resize(S, 11) = Application.Transpose(Application.Transpose(Ar))
Sheets("領用記錄明細表 (2)").Cells(r, 1).Resize(S, 11) = Application.Transpose(Application.Transpose(Ar))

End If
End If
End If
End If
End With
End Sub


這個是我改的vba:

Sub 領用單寫入()
Dim Ar()
With Sheets("領用單")
If Cells(3, 2) = "" Then
MsgBox "請輸入部門"
Else
If Cells(4, 2) = "" Then
MsgBox "請輸入領用人名字"
Else
If Cells(3, 8) = "" Then
MsgBox "請輸入日期"
Else
If Application.CountA(.[A6:A16]) > 0 Then
For Each a In .[A6:A16].SpecialCells(xlCellTypeConstants)
  ReDim Preserve Ar(S)
  Ar(S) = Array(.[B3].Value, .[B4].Value, .[H3].Value, a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value, a.Offset(, 7).Value., a.Offset(, 8).Valuea.Offset(, 9).Value)
  S = S + 1
Next
r = Application.CountA(Sheets("領用記錄明細表").[A:A]) + 2
r = Application.CountA(Sheets("領用記錄明細表 (2)").[A:A]) + 2
Sheets("領用記錄明細表").Cells(r, 1).Resize(S, 11) = Application.Transpose(Application.Transpose(Ar))
Sheets("領用記錄明細表 (2)").Cells(r, 1).Resize(S, 11) = Application.Transpose(Application.Transpose(Ar))

End If
End If
End If
End If
End With
End Sub

我複上我要改的圖片  
[attach]15460[/attach]  [attach]15461[/attach]

---

作者: stillfish00    時間: 2013-7-16 19:32

回復 1# JEAN
是否這裡沒改到?

Sheets("領用記錄明細表").Cells(r, 1).Resize(S, 13) = Application.Transpose(Application.Transpose(Ar))
Sheets("領用記錄明細表 (2)").Cells(r, 1).Resize(S, 13) = Application.Transpose(Application.Transpose(Ar))

---

作者: JEAN    時間: 2013-7-19 15:57

回復 2# stillfish00


   嗯嗯.好,謝謝您

---

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