請問我要如何改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

我複上我要改的圖片

未命名.rar (59.27 KB)

未命名2.rar (91.79 KB)

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 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))

TOP

JEAN

中學生 Rank: 2

帖子: 91
主題: 20
精華: 0
積分: 118
點名: 0
作業系統: WINDOWS
軟體版本: XP
閱讀權限: 20
性別: 女
註冊時間: 2011-11-30
最後登錄: 2016-1-14

3^#

發表於 2013-7-19 15:57 | 只看該作者

回復 2# stillfish00

嗯嗯.好,謝謝您

TOP