| |
▼Help me!! さん：
こんにちは
とりあえず追加してみました。
が、りんさんのコードのほうがコメントもきちんと
書かれていてやすいと思います。
だったらコメントくらい書けと言われそうですが･･･
今回もコメントなしです、ごめんなさい。
Private Sub 差額一覧表作成()
Const strSheet1 As String = "Sheet1"
Const strSheet2 As String = "Sheet2"
Const strSheet3 As String = "Sheet3"
Dim WK() As Variant
Dim WD() As Variant
Dim RE As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Flg As Boolean
With Sheets(strSheet1)
RE = .Range("A65536").End(xlUp).Row
ReDim WK(1 To 27, 1 To RE) As Variant
j = 1
For i = 1 To RE
For j = 1 To 27
WK(j, i) = .Cells(i, j).Value
Next j
Next i
End With
With Sheets(strSheet2)
RE = .Range("A65536").End(xlUp).Row
For i = 1 To RE
Flg = False
For j = 1 To UBound(WK, 2)
If WK(1, j) = .Cells(i, 1) Then
If IsNumeric(.Cells(i, 2).Value) Then
WK(2, j) = WK(2, j) - .Cells(i, 2).Value
End If
For k = 3 To 11
WK(16 + k, j) = .Cells(i, k).Value
Next k
Flg = True
Exit For
End If
Next j
If Flg = False Then
ReDim Preserve WK(1 To 27, 1 To UBound(WK, 2) + 1) As Variant
WK(1, UBound(WK, 2)) = .Cells(i, 1).Value
WK(2, UBound(WK, 2)) = -.Cells(i, 2).Value
For k = 3 To 11
WK(16 + k, UBound(WK, 2)) = .Cells(i, k).Value
Next k
End If
Next i
End With
ReDim WD(1 To UBound(WK, 2), 1 To 27) As Variant
For i = 1 To UBound(WK, 2)
For j = 1 To 27
WD(i, j) = WK(j, i)
Next
Next
WD(1, 2) = "金額の差異"
With Sheets(strSheet3)
.UsedRange.Clear
.Range("a2:a" & UBound(WD, 1)).NumberFormat = "@"
.Range("c2:d" & UBound(WD, 1)).NumberFormat = "@"
.Range("e2:e" & UBound(WD, 1)).NumberFormat = "gee/mm/dd"
.Range("f2:i" & UBound(WD, 1)).NumberFormat = "@"
.Range("m2:t" & UBound(WD, 1)).NumberFormat = "@"
.Range("w2:z" & UBound(WD, 1)).NumberFormat = "@"
.Range("aa2:aa" & UBound(WD, 1)).NumberFormat = "gee/mm/dd"
.Range("A1:AA" & UBound(WD, 1)) = WD
End With
End Sub
|
|
こたつねこ
- 05/9/2(金) 15:30 -
