初めて質問させていただきます。
VBA初心者の為、質問自体に不足があるかもしれませんが、ご協力をお願い致します。
エクセル2000(SP3)で複数のブック（仮にA.xls,B.xlsとします）を起動した状態で、Aをマクロを使って保存せずに終了させたところ、Bの操作が出来なくなります。（セル選択等もできません。Bのsheetを選択するとアプリケーションエラーになってしまいます）
同Windows上に他アプリケーションが起動している場合、それらを一度選択してから再度Excelを選択すると、Bの操作が可能になります。
保存せずに終了させる為のマクロは次のとおりです。
ブックAのThisWorkbook内に記述しています。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Workbooks.count = 1 Then
Application.DisplayAlerts = False
Application.Quit
Else
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
以上、よろしくお願い致します。
ExcelVBAを使用して、データを転記集約させる作業をしたいと思っています。
詳しく言いますと、同一のフォルダ内に各店からの注文書のファイルを保存し（フォーマットは同じ）、それを集計用のファイルで、それぞれ入力してあるデータを読み込み一覧にしていくという作業です。
転記部分をサブルーチンにしています。
実行すると、最後の
topRng.PasteSpecial xlPasteValues
でエラーになり、「実行時エラー1004 この操作には同じサイズの結合セルが
必要です」とメッセージが出ます。
そこで結合セルを解除したのですが、同じメッセージが出てしまいます。
どこをどう修正すればよいのか、お教え頂けないでしょうか？
転記先のセルの開始位置の取得が間違っているのでしょうか？
宜しくお願いいたします。
Dim keyRng As Range
Sub 集計開始()
myDir = "D:\集計用"
flg = 0
ChDir myDir
MyName = Dir(myDir & "\*.xls")
Do While MyName <> ""
Set mybook = Workbooks.Open(MyName)
Call 転記(mybook.Sheets(1).Range("D6"), flg)
flg = 1
Application.DisplayAlerts = False
mybook.Close
Application.DisplayAlerts = True
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox ("集計処理が終わりました")
End If
End Sub
Sub 転記(myRng, mytitle)
Set keyRng = Range("A1")
If keyRng = "" And keyRng.Offset(1) = "" Then
Set topRng = keyRng
Else
Set topRng = keyRng.End(xlDown).Offset(1)
End If
Set mytbl = myRng.CurrentRegion
If mytitle = 1 Then
Set mytbl = mytbl.Offset(1, 0).Resize(mytbl.Rows.Count - 1, mytbl.Columns.Count)
End If
mytbl.Copy
topRng.PasteSpecial xlPasteValues
End Sub
ExcelVBAを使用して、データを転記集約させる作業をしたいと思っています。
詳しく言いますと、同一のフォルダ内に各店からの注文書のファイルを保存し（フォーマットは同じ）、それを集計用のファイルで、それぞれ入力してあるデータを読み込み一覧にしていくという作業です。
転記部分をサブルーチンにしています。
実行すると、最後の
topRng.PasteSpecial xlPasteValues
でエラーになり、「実行時エラー1004 この操作には同じサイズの結合セルが
必要です」とメッセージが出ます。
そこで結合セルを解除したのですが、同じメッセージが出てしまいます。
どこをどう修正すればよいのか、お教え頂けないでしょうか？
転記先のセルの開始位置の取得が間違っているのでしょうか？
宜しくお願いいたします。
Dim keyRng As Range
Sub 集計開始()
myDir = "D:\集計用"
flg = 0
ChDir myDir
MyName = Dir(myDir & "\*.xls")
Do While MyName <> ""
Set mybook = Workbooks.Open(MyName)
Call 転記(mybook.Sheets(1).Range("D6"), flg)
flg = 1
Application.DisplayAlerts = False
mybook.Close
Application.DisplayAlerts = True
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox ("集計処理が終わりました")
End If
End Sub
Sub 転記(myRng, mytitle)
Set keyRng = Range("A1")
If keyRng = "" And keyRng.Offset(1) = "" Then
Set topRng = keyRng
Else
Set topRng = keyRng.End(xlDown).Offset(1)
End If
Set mytbl = myRng.CurrentRegion
If mytitle = 1 Then
Set mytbl = mytbl.Offset(1, 0).Resize(mytbl.Rows.Count - 1, mytbl.Columns.Count)
End If
mytbl.Copy
topRng.PasteSpecial xlPasteValues
End Sub
ExcelVBAを使用して、データを転記集約させる作業をしたいと思っています。
詳しく言いますと、同一のフォルダ内に各店からの注文書のファイルを保存し（フォーマットは同じ）、それを集計用のファイルで、それぞれ入力してあるデータを読み込み一覧にしていくという作業です。
転記部分をサブルーチンにしています。
実行すると、最後の
topRng.PasteSpecial xlPasteValues
でエラーになり、「実行時エラー1004 この操作には同じサイズの結合セルが
必要です」とメッセージが出ます。
そこで結合セルを解除したのですが、同じメッセージが出てしまいます。
どこをどう修正すればよいのか、お教え頂けないでしょうか？
転記先のセルの開始位置の取得が間違っているのでしょうか？
宜しくお願いいたします。
Dim keyRng As Range
Sub 集計開始()
myDir = "D:\集計用"
flg = 0
ChDir myDir
MyName = Dir(myDir & "\*.xls")
Do While MyName <> ""
Set mybook = Workbooks.Open(MyName)
Call 転記(mybook.Sheets(1).Range("D6"), flg)
flg = 1
Application.DisplayAlerts = False
mybook.Close
Application.DisplayAlerts = True
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox ("集計処理が終わりました")
End If
End Sub
Sub 転記(myRng, mytitle)
Set keyRng = Range("A1")
If keyRng = "" And keyRng.Offset(1) = "" Then
Set topRng = keyRng
Else
Set topRng = keyRng.End(xlDown).Offset(1)
End If
Set mytbl = myRng.CurrentRegion
If mytitle = 1 Then
Set mytbl = mytbl.Offset(1, 0).Resize(mytbl.Rows.Count - 1, mytbl.Columns.Count)
End If
mytbl.Copy
topRng.PasteSpecial xlPasteValues
End Sub
ExcelVBAを使用して、データを転記集約させる作業をしたいと思っています。
詳しく言いますと、同一のフォルダ内に各店からの注文書のファイルを保存し（フォーマットは同じ）、それを集計用のファイルで、それぞれ入力してあるデータを読み込み一覧にしていくという作業です。
転記部分をサブルーチンにしています。
実行すると、最後の
topRng.PasteSpecial xlPasteValues
でエラーになり、「実行時エラー1004 この操作には同じサイズの結合セルが
必要です」とメッセージが出ます。
そこで結合セルを解除したのですが、同じメッセージが出てしまいます。
どこをどう修正すればよいのか、お教え頂けないでしょうか？
転記先のセルの開始位置の取得が間違っているのでしょうか？
宜しくお願いいたします。
Dim keyRng As Range
Sub 集計開始()
myDir = "D:\集計用"
flg = 0
ChDir myDir
MyName = Dir(myDir & "\*.xls")
Do While MyName <> ""
Set mybook = Workbooks.Open(MyName)
Call 転記(mybook.Sheets(1).Range("D6"), flg)
flg = 1
Application.DisplayAlerts = False
mybook.Close
Application.DisplayAlerts = True
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox ("集計処理が終わりました")
End If
End Sub
Sub 転記(myRng, mytitle)
Set keyRng = Range("A1")
If keyRng = "" And keyRng.Offset(1) = "" Then
Set topRng = keyRng
Else
Set topRng = keyRng.End(xlDown).Offset(1)
End If
Set mytbl = myRng.CurrentRegion
If mytitle = 1 Then
Set mytbl = mytbl.Offset(1, 0).Resize(mytbl.Rows.Count - 1, mytbl.Columns.Count)
End If
mytbl.Copy
topRng.PasteSpecial xlPasteValues
End Sub
オートフィルタで抽出した値をリストボックスに代入する為の
コードがあります。
前任者が書いたコードですが、何とか動作を確認しながら
変更しようとしたのですが、わかりませんでした。
やりたいこと
Application.Intersect(SS, SS.Offset(1)).Copyからxに格納した
値をmyList(i, 1) = xでリストボックスに入れたい。
問題点
For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next
上記の後に
For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next
が実行される際にｖの値が重複を除いて、順番にリストに
入る動作が理解できません。
どなたかアドバイスお願いします。
Private Sub ComboBox1_Change()
Dim 開始日 As Date
Dim 終了日 As Date
Dim i, ii As Long, v, x As Variant
Dim Sh1 As Worksheet
Set Sh1 = Sheets("日報")
Set RR = Sh1.Range("A4").CurrentRegion
Set CC = RR.Columns(8)
Set SS = RR.Columns(9)
開始日 = DateValue(ComboBox1.Value)
終了日 = DateSerial(Year(開始日), Month(開始日) + 1, Day(開始日)) - 1
RR.Worksheet.AutoFilterMode = False ' B列 開始日から月末までの期間を抽出
RR.AutoFilter Field:=1, _
Criteria1:=">=" & 開始日, Operator:=xlAnd, _
Criteria2:="<=" & 終了日
Application.Intersect(CC, CC.Offset(1)).Copy '8行目をコピー
With New DataObject
.GetFromClipboard
v = Split(.GetText, vbCrLf) 'vに代入
Application.Intersect(SS, SS.Offset(1)).Copy '9行目をコピー
.GetFromClipboard
x = Split(.GetText, vbCrLf) 'xに代入
End With
With CreateObject("Scripting.Dictionary")
For i = 0 To UBound(v) - 1
.Item(v(i)) = .Item(v(i)) + 1 'アイテムのカウント
Next
ReDim myList(1 To .Count, 2)
i = 0
For Each v In .Keys
i = i + 1
myList(i, 0) = v '8行目の値
myList(i, 1) = x '9行目の値を入れたい
myList(i, 2) = .Item(v) '8行目のカウント数
Next
ListBox1.ColumnCount = 3
ListBox1.List = myList()
End With
RR.Worksheet.AutoFilterMode = False
RR.Worksheet.Application.CutCopyMode = False
End Sub
