- ベストアンサー
Excel VBAでのセルの範囲指定
jukateの回答
- jukate
- ベストアンサー率25% (14/56)
Sub hanten() For m = 1 To 100 For n = 1 To 100 Sheet2.Cells(n, m) = Sheet1.Cells(m, n) Next n Next m Sheet2.Activate Cells.Select Selection.Copy Dim bookb As Excel.Application Set bookb = New Excel.Application bookb.Workbooks.Open ("c:\B.xls") bookb.Visible = True bookb.ActiveSheet.Paste End Sub 見当違いかもしれないですが、・・・ 範囲ぐらいは自分で考えてください。 もう少し手間かかります、それから 人それぞれですし。
関連するQ&A
- Excel・VBAで・・。
A ｜ B ｜ C 1 あああ<>いい<> ｜ ｜ 2 あああ<>うう<> ｜ ｜ 3 えええ<>おお<> ｜ ｜ A ｜ B ｜ C ｜ D ｜ 1 あああ<>いい<> ｜ あああ ｜ いい<> ｜ いい ｜ 2 あああ<>うう<> ｜ あああ ｜ うう<> ｜ うう ｜ 3 えええ<>おお<> ｜ えええ ｜ おお<> ｜ おお ｜ というようになるようにしたいのです。 そこで、こんな感じのコードをかきました。 i = 1 i2 = 1 Do While Cells(i, i2).Value <> "" Do While Cells(i, i2).Value <> "" Namae = Cells(i, i2).Value Point = InStr(1, Namae, "<>") Cells(i, i2 + 1).Value = Left(Namae, Point - 1) Cells(i, i2 + 2).Value = Mid(Namae, Point + 2) i = i + 1 Loop i2 = i2 + 2 Loop でもD列までいかないで、C列で止まってしまうんです。 1つ目のDo whileが原因かな？と思ってるんですが、どう直したらいいかわかりません。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA SumIfについて教えてください。
【やりたいこと】 A列が「犬」となっている行のB列数字を全て足してCの1行目に答えデータを入れる。 A B C 犬 200 猫 100 鳥 150 犬 130 犬 120 ・ ・ ・ ・ ・ ・ ・ ・ 上記の場合、A列が「犬」のB列数字200+130+120でC1には「450」と値が入る。 以下が書いてみたものですがエラーが出てしまいます。 何がいけないのでしょうか？ご教示頂ければ幸いです。 Sub monthResult() Dim ans As String 'ユーザフォームで「犬」という値を取得 i = 2 Do Until Worksheets("データ").Cells(i, 1).Value = "" 'データという名前のシートA列のデータが無くなるまで Worksheets("データ").Cells(1, 3).Value = Application.WorksheetFunction.SumIf(Cells(i, 1).Value, ans, Cells(i, 2).Value) '↑ここでエラーになります。ans（犬）の値は取得出来ています。 i = i + 1 Loop End Sub
- ベストアンサー
- SE・インフラ・Webエンジニア
- 表を新しいブックに保存
Sub 表を新しいブックに保存反映日ごと() Application.ScreenUpdating = False Dim フルパス As String, ファイル名 As String, パス As String, 新ファイル名 As String 新ファイル名 = ActiveSheet.Name フルパス = ActiveWorkbook.FullName ファイル名 = Dir(フルパス) 'パスを取得 パス = Replace(フルパス, ファイル名, "") '表の範囲選択をする Range("A1").Select Dim 行数 As Long, 列数 As Long 行数 = 1 列数 = 1 Do While Cells(行数, 1) <> "" 行数 = 行数 + 1 Loop 行数 = 行数 - 1 Do While Cells(1, 列数) <> "" 列数 = 列数 + 1 Loop 列数 = 列数 - 1 Range(Cells(1, 1), Cells(行数, 列数)).Select Selection.Copy '新しいブックを開く Workbooks.Add Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Do While Range("A2") <> "" Range("A1").Select '一番上の発売日の範囲を取得 Range("A2").Select Dim 列 As Long Dim i As Long 列 = 1 '列数を取得 Do While Cells(1, 列) <> "" 列 = 列 + 1 Loop 列 = 列 - 1 '発売日ごとのデータ量を取得 i = 2 Do Until Cells(i, 1) <> Range("A2").Value i = i + 1 Loop i = i - 1 '発売日のまとまりのデータ範囲を選択 Range(Cells(1, 2), Cells(i, 列)).Select '発売日ごとのデータをコピー Selection.Copy '発売日を取得 Dim 発売日 As Long 発売日 = Range("A2").Value '新しいブックを追加してシート名を発売日に設定 Workbooks.Add ActiveSheet.Name = 発売日 新ファイル名 = ActiveSheet.Name Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select 'シート名をファイル名にして保存 ActiveWorkbook.SaveAs Filename:=パス & "メンテ_" & 新ファイル名 & ".xls", _ FileFormat:=xlExcel8, _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWindow.Close Range("A1").Select '保存された発売日分のデータを削除 Range(Cells(2, 1), Cells(i, 列)).Select Selection.Delete Shift:=xlUp Loop '不要になった表転記用ブックを閉じる Application.DisplayAlerts = False ActiveWindow.Close Application.DisplayAlerts = True Range("A1").Select Application.ScreenUpdating = True End Sub Sub 表を新しいブックに保存() Application.ScreenUpdating = False Dim フルパス As String, ファイル名 As String, パス As String, 新ファイル名 As String 新ファイル名 = ActiveSheet.Name フルパス = ActiveWorkbook.FullName ファイル名 = Dir(フルパス) 'パスを取得 パス = Replace(フルパス, ファイル名, "") '表の範囲選択をする Range("A1").Select Dim 行数 As Long, 列数 As Long 行数 = 1 列数 = 1 Do While Cells(行数, 1) <> "" 行数 = 行数 + 1 Loop 行数 = 行数 - 1 Do While Cells(1, 列数) <> "" 列数 = 列数 + 1 Loop 列数 = 列数 - 1 Range(Cells(1, 1), Cells(行数, 列数)).Select Selection.Copy '新しいブックを開く Workbooks.Add Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select 'シート名をファイル名にして保存 ActiveWorkbook.SaveAs Filename:=パス & 新ファイル名 & ".xls", _ FileFormat:=xlExcel8, Password:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWindow.Close Range("A1").Select Application.ScreenUpdating = True End Sub
- 締切済み
- Excel（エクセル）
- vba 記述をスマートにしたい
お世話になります。 以下の記述をもっと簡略化させたいのですが、 列とシートが違うだけで、同じ処理を２回しているだけなので、 出来そうで、自分では出来ませんでした。 どなたかご教示頂きたく宜しくお願い致します。 記 Set myrngv = Workbooks("Ａ.xls").Sheets("sheet1").Range("a:a") Set myrngYK = Workbooks("Ａ.xls").Sheets("sheet1").Range("t:t") Set myrialz = Workbooks("Ａ.xls").Sheets("sheet2").Range("b:b") Set myXBrialz = Workbooks("Ａ.xls").Sheets("sheet3").Range("b:b") j = 3 Do j = j + 1 myhin = myrngv.Cells(j, 1).Value If myhin = "" Then Exit Do Set c = myrialz.Find(what:=myhin, Lookat:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do myrow = c.Row myrngv.Cells(j, 9) = myrialz.Cells(myrow, 7).Value myrngv.Cells(j, 11) = myrialz.Cells(myrow, 8).Value myrngv.Cells(j, 13) = myrialz.Cells(myrow, 3).Value myrngv.Cells(j, 5) = myrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value Set c = myrialz.FindNext(c) Loop Until firstaddress = c.Address End If Loop 'ここより下が同じ様な処理 j = 3 Do j = j + 1 myhin = myrngYK.Cells(j, 1).Value If myhin = "" Then Exit Do Set c = myXBrialz.Find(what:=myhin, Lookat:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do myrow = c.Row myrngYK.Cells(j, 8) = myXBrialz.Cells(myrow, 7).Value myrngYK.Cells(j, 10) = myXBrialz.Cells(myrow, 8).Value myrngYK.Cells(j, 12) = myXBrialz.Cells(myrow, 3).Value myrngYK.Cells(j, 6) = myXBrialz.Cells(myrow, 3).Value + Cells(myrow, 7).Value - Cells(myrow, 8).Value Set c = myXBrialz.FindNext(c) Loop Until firstaddress = c.Address End If Loop
- ベストアンサー
- Visual Basic
- エクセルVBAで解らない部分があります。
エクセルVBAで解らない部分があるのでどなたか教えてください。 ある表から特定の日付を探して抜き出すVBAを組み込んだファイルに下記のような記述がありました。 y=1:i=1 do set tmp=workbooks("B").sheets(1).rows(2).find(workbooks("A").sheets(1).cells(y,1),lookat:=xlwhole) if not tmp is nothing then Workbooks("B").sheets(2).cells(i,1)=workbooks("A").sheets(1).cells(y,1) '～略～ i=i+1 end if y=y+1 loop until y=workbooks("A").sheets(1).range("A65536").end(xlup).row この中の「y=1:i=1」がよくわかりません。どなたか解る方どういう意味か教えてくれませんか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい
VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい エクセル関数でいうとVlookUPをしたいのですが、1004エラーがかかってしまいます。 必要なところだけを抜き取っているので、分かりにくいかと思いますが、 Dim a, b, c, d, y, x, z, i, j, k, m, n, o, r As Long a = 2 '2 なのは、A2から数えるため。 b = 0 'BookBのレコードの数を数えるための変数。 Do While Workbooks("B.xls").Worksheets("Sheet1").Cells(a, 1) <> "" a = a + 1 b = b + 1 Loop Workbooks("B.xls").Activate For k = 2 To b For m = 2 To 300000 エラー⇒ If Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 1) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 1) Then Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 12) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 2) Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 13) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 3) End If Next m Next k ・ ・ ・ の部分でつまっています＞＜； 説明が不十分でしたら追加いたしますので、初心者の簡単なエラーだとは思うのですが、教えてください＜（＿＿）＞
- ベストアンサー
- その他（プログラミング・開発）
- excelのファイルとセル値を書き出したい
excel2003を利用しています。 とあるフォルダにある excelファイル名(自分自身のファイルを除く） を全て書き出して、 且つ A１セルの値をB列に書き出すことを、やろうとvbaを作ってみましたが。 最後のファイルのA1セルを書きだすところで、エラーになっていまい そこだけ空白になってしまいます。※写真参照 記述は以下の通りです。どのように修正すればよいか 教えていただけないでしょうか？ また他にもっと優れた記述があれば、そちらも教えて欲しいです。 よろしくお願いします。 Sub test() Dim buf As String, cnt As Long Dim Path As String Path = ThisWorkbook.Path & "\" buf = Dir(Path & "*.xls") cnt = 2 Do While buf <> "" If buf <> ThisWorkbook.Name Then cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Workbooks.Open Filename:=Path & "\" & buf MsgBox Workbooks(buf).Worksheets(1).Range("A1").Value Cells(cnt, 2) = Workbooks(buf).Worksheets(1).Range("A1").Value Workbooks(buf).Close End If Loop End Sub
- 締切済み
- Excel（エクセル）
- ExcelのVBAについて
こんにちは、VBA初心者です。 C:\pictureの中に以下のファイルがあります。 DSC_0134.JPG～DSC_0154.JPG これらのファイルをExcelのA列1～20行に書かれた文字△○％＆◎～▲▽％％★に.JPGをつけて保存したくて以下のコードを書きました。 Dim buf As String Dim msg As String Dim i As Integer Dim A As Variant i = 1 buf = Dir("dsc*.jpg", vbNormal) Do While buf <> "" Do While i < 21 buf = Dir() msg = buf 'msg=元の名前 A = Worksheets("sheet1").Cells(i, 1).Value Worksheets("sheet1").Cells(i, 2).Value = msg Name "C:\picture\msg" As "C:\picture\A.jpg" i = i + 1 Loop Loop Name "C:\picture\msg" As "C:\picture\A.jpg"のところで、「ファイルがありません。」となってしまいます。 あと、Worksheets("sheet1").Cells(i, 2).Value = msgのところで、\pictureの中の最初のファイル（DSC_0134.JPG）を表示しません。 どこを直せばよいのでしょうか？
- ベストアンサー
- Visual Basic
- エクセルVBAで困っています。
Excell2003でマクロを作成したのですが、思うような結果が出なくて困っています。 どなたかお力をお貸しください。 お願いします。 【作成したマクロ】 Sub テスト() myPath = ThisWorkbook.Path buf = Dir(myPath & "￥データ￥" & "*.xls") Do While buf <> "" Target = "'" & myPath & "[" & buf & "]Sheet1'!R1C1" i = i + 1 Cells(i, 1) = buf Cells(i, 2) = ExecuteExcel4Macro(Target) buf = Dir() Loop End Sub 【設定状況】 ・デスクトップ上に "サンプル.xls" があり、ThisWorkBookに上記マクロを書きました。 ・デスクトップ上に "データ" というフォルダがあり、その中に、"Book1.xls" と "Book2.xls" があります。 ・"Book1.xls" のSheet1のRange("A1")には "あいうえお" が入力されています。 ・"Book2.xls" のSheet1のRange("A1")には "かきくけこ" が入力されています。 【マクロ実行結果】 ・Range("A1") ・・・ Book1.xls ・Range("B1") ・・・ #REF! ・Range("A2") ・・・ Book2.xls ・Range("B2") ・・・ #REF! となってしまいます。 【求めたい結果】 ・Range("A1") ・・・ Book1.xls ・Range("B1") ・・・ あいうえお ・Range("A2") ・・・ Book2.xls ・Range("B2") ・・・ かきくけこ よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- 異なるブック間でのセル範囲のコピー/VBA
異なるブック間でクリップボードを経由せず直接コピーしたいため 下記のマクロを記述していますが、実行エラーが発生します。 どうしてでしょうか。 ThisWorkbook.Worksheets(3).Range(Cells(3, 1), Cells(3 + a, 1)).Value = Workbooks("excel.xls").Worksheets(1).Range(Cells(11, 3), Cells(11 + a, 3)).Value (補足) (1)VBA実行中のThisWorkbook、excel.xlsは別のブック ですが、同じフォルダにあります。 (2)aは数値が入る変数です。
- ベストアンサー
- Visual Basic
お礼
ありがとうございます。 これだと、表のサイズが１００x１００で決まってしまいます。 又、シート全体のコピぺになってしまいますし、行列の反転をしている為、反転後の列の数が足らなくなってしまいます。 ただ、行が２５６迄しか使えない事に気が付きました。