- ベストアンサー
Excel VBA繰り返し文の簡潔な書き方
- Excel VBAで繰り返し文を簡潔に書く方法を紹介します。
- 上記のコードを以下のように書き換えて簡潔にすることができます。
- RangeオブジェクトのFor Eachループを使用すると、簡潔に繰り返し処理を行うことができます。
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (3)
- xls88
- ベストアンサー率56% (669/1189)
直接取得することもできます。 三流君VBAでIE操作 InternetExplorer.Applicationを操作する http://www.ken3.org/cgi-bin/group/vba_ie.asp
お礼
ありがとうございます。(^^) できればいいのですが、難しそうです。
- xls88
- ベストアンサー率56% (669/1189)
もう一例 Sub test3() Dim ctrl As OLEObject Dim i As Long For Each ctrl In ActiveSheet.OLEObjects If ctrl.Name Like "HTMLText*" Then i = i + 1 ActiveSheet.Cells(i, "A").Value = ctrl.Object.Value End If Next ctrl End Sub
お礼
ありがとうございました。(^^)
- xls88
- ベストアンサー率56% (669/1189)
HTMLText1～HTMLText10の正体が解らないので、通らないと思いますが 一例を示すと、下記のように記述します。 Sub teat1() Dim i As Long With Sheets("最初") For i = 1 To 10 Cells(i, "M").Value = .HTMLText(i).Value '★1 Next i End With End Sub ★1のところは Range("M" & i).Value = .HTMLText(i).Value というようにもできます。
お礼
ありがとうございます。 HTMLText10は、ホームページを全選択後、コピーしてExcelシートに貼り付けた時にあったテキストボックスです。このたくさんのテキストボックスの値をセルに書き出そうとしています。
関連するQ&A
- Ｅｘｃｅｌ VBA 実行時エラー'1004':
どちらの処理がより高速であるのかを調べるため、以下の2つのVBAを試作致しました。 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 処が、これらのVBAを実際に動作させ様としますと、どちらの場合においても「Microsoft Visual Basic」ダイアログボックスが開いて 「実行時エラー'1004': 'Range'メソッドは失敗しました:'_Global'オブジェクト」 と表示されてしまいます。 さりとて、 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select ActiveSheet.Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 或いは Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range(Cells(i, 1)).Value = Rnd Next i Range("B1").Select End Sub 等としましても、今度は 「実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。」 となってしまいます。 どの部分がどの様に悪いのでしょうか？ そして、どの様に修正すれば良いのでしょうか？ 尚、使用しておりますＥｘｃｅｌのバージョンはＥｘｃｅｌ2010です。
- ベストアンサー
- オフィス系ソフト
- VBAについて教えて下さい
EXCEL2010を使用中。 独学で、Web上で色々検索したものをパクリながら VBAを組んでるようなレベルです。 今回教えて頂きたい内容ですが、 カード型の入力シート「Sheet名:入力」を作成して、 登録ボタンでデータベースシート「Sheet名:スケジュール」に 書き足していくような業務スケジュール表を作成中です。 わざわざそんな手のこんだものを 作らなくてもと思われるかもしれませんが 諸事情があっての事なので 登録ボタンのVBAは Private Sub 登録_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("スケジュール").Columns(1)) + 1 Sheets("スケジュール").Cells(row, 1).Value = Range("Q2").Value Sheets("スケジュール").Cells(row, 2).Value = Range("G6:G7").Value Sheets("スケジュール").Cells(row, 3).Value = Range("G8:G9").Value Sheets("スケジュール").Cells(row, 4).Value = Range("G10:G11").Value Sheets("スケジュール").Cells(row, 5).Value = Range("G12:G13").Value Sheets("スケジュール").Cells(row, 6).Value = Range("G14:G15").Value Sheets("スケジュール").Cells(row, 7).Value = Range("G16:G17").Value Sheets("スケジュール").Cells(row, 8).Value = Range("G18:G19").Value Sheets("スケジュール").Cells(row, 9).Value = Range("G20:G21").Value Sheets("スケジュール").Cells(row, 10).Value = Range("G22:G23").Value Sheets("スケジュール").Cells(row, 11).Value = Range("G24:G25").Value Sheets("スケジュール").Cells(row, 12).Value = Range("M6:M7").Value Sheets("スケジュール").Cells(row, 13).Value = Range("M8:M9").Value Sheets("スケジュール").Cells(row, 14).Value = Range("M10:M11").Value Sheets("スケジュール").Cells(row, 15).Value = Range("M12:M13").Value Sheets("スケジュール").Cells(row, 16).Value = Range("M14:M15").Value Sheets("スケジュール").Cells(row, 17).Value = Range("M16:M17").Value Sheets("スケジュール").Cells(row, 18).Value = Range("M18:M19").Value Sheets("スケジュール").Cells(row, 19).Value = Range("M20:M21").Value Sheets("スケジュール").Cells(row, 20).Value = Range("M22:M23").Value Sheets("スケジュール").Cells(row, 21).Value = Range("M24:M25").Value Sheets("スケジュール").Cells(row, 22).Value = Range("S6:S7").Value Sheets("スケジュール").Cells(row, 23).Value = Range("S8:S9").Value Sheets("スケジュール").Cells(row, 24).Value = Range("S10:S11").Value Sheets("スケジュール").Cells(row, 25).Value = Range("S12:S13").Value Sheets("スケジュール").Cells(row, 26).Value = Range("S14:S15").Value Sheets("スケジュール").Cells(row, 27).Value = Range("S16:S17").Value Sheets("スケジュール").Cells(row, 28).Value = Range("S18:S19").Value Sheets("スケジュール").Cells(row, 29).Value = Range("S20:S21").Value Sheets("スケジュール").Cells(row, 30).Value = Range("S22:S23").Value Sheets("スケジュール").Cells(row, 31).Value = Range("S24:S25").Value Sheets("スケジュール").Cells(row, 32).Value = Range("S26:S27").Value Range("Q1").Select End Sub としています。 この時、移行するセル内の文字数が指定文字数を超えると、 移行した先のセルの書式設定を「折り返して全体を表示する」に 設定変更をしたいですのですが、その方法について ご教授いただけないでしょうか？ 因みに現在の設定は、「縮小して全体を表示する」としています。
- ベストアンサー
- その他MS Office製品
- VBA空白を除いてコピーが出来ません。ご指導お願いします。
値のコピー＆ペースト（空白を除いてコピー）したいと思っております。 シート１ の A35、D35、I35 をコピー。 シート２ の A2 に貼り付け。 これは、大丈夫です。 シート１ の M2 ： O23 をコピー。 シート２ の E2 に貼り付け。 今回の場合ですと、M2 ： O13 までに値が入ってます。 ですので、M14 ： O23 までが、空白になって記入となってしまいます。 ＊毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14 ： O23 までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Ｅｘｃｅｌ VBAについて。
ＶＢＡに詳しい方に質問です。 次の2つのプログラムが何をしているのか詳しく教えて下さい。 Sub Macro1() Sheets("Sheet1").Range("A1").QueryTable.Refresh BackgroundQuery:=False End Sub ------------------------- Function LNK(rng As Range) LNK = rng.Hyperlinks(1).Address End Function
- ベストアンサー
- その他MS Office製品
- エクセルVBA
VBAの素人です。 以下のようなVBAを実行しようと、何とか形にしました。 単独のBOOKではうまくいくのですが、同時に他のBOOKを開くと 「インデックスが有効範囲にありません」とエラーになります。 エラー箇所は、With Sheets("Sheet1").Range("B1")部分です。 修正をご教示頂ける方、何卒よろしくお願い致します。 全くVBA無知なのにすみません。 Private Sub Workbook_Open() test01 test02 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub Sub 終了() Application.OnTime Now + TimeValue("0:00:02"), "test01", , False ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("Sheet1").Range("B1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:02"), "test01" End Sub Sub test02() With Sheets("Sheet1").Range("B2") .Value = Time .NumberFormatLocal = "mm:ss" End With End Sub
- 締切済み
- オフィス系ソフト
- Excel VBA: コンボボックスの値取得
社内システムのIEブラウザからExcelに貼り付けたテキストボックスは、以下のように取得できました。 Sheets("伝票").Range("B1").Value = Sheets("伝票").HTMLText1.Value ただ、コンボボックス(ドロップダウンメニューが出てくるもの)の選択文字列は以下で取得できませんでした。取得方法はありますでしょうか? Sheets("伝票").Range("B1").Value = Sheets("伝票").HTMLSelect1.Value
- 締切済み
- オフィス系ソフト
- ＥＸＣＥＬ ＶＢＡで作成したスクロールバーの不具合を修正したいのですが
ちょっと言葉だと説明しにくいのですが、教えていただきたいことがあります。 ＥＸＣＥＬ ＶＢＡでスクロールバーを作成したのですが、 スクロールバーの上部1/5程度で全部のデータが終わってしまいます。 データ数に合わせて、スクロールした一番最後に最後のデータが来るように修正することは可能でしょうか。 自分で色々試してみましたが原因がさっぱりわかりませんでした。 作成したマクロは以下のとおりです。 ＊シート「一覧」のＡ列～Ｄ列×３０００行のデータを入力 シート「リスト」にスクロールバーを設置 Private Sub ScrollBar1_Change() currow = ScrollBar1.Value Call smpscrollbar End Sub Private Sub Workbook_Open() currow = 3 With Sheets("リスト").ScrollBar1 .Min = 3 .Max = Sheets("一覧").Range("A1").CurrentRegion.Rows.Count End With Call smpscrollbar End Sub Sub smpscrollbar() With Sheets("リスト") .Range("B1").Value = Sheets("一覧").Range("A" & currow).Value .Range("E1").Value = Sheets("一覧").Range("B" & currow).Value .Range("I1").Value = Sheets("一覧").Range("C" & currow).Value .Range("N1").Value = Sheets("一覧").Range("D" & currow).Value End With End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBA セルの双方向同期のエラーについ
エラーが発生して理由がわからないので、どなたか助言をお願いします。 以下のVBAにて、目的のセルにデータを入力すると、1回目は必ず添付写真の通りのエラーが出まして、デバッグをすると3行目が黄色でハイライトされます。 記述は以下の通りです。どうぞよろしくお願いします。 シートAへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("シートB").Range("$B$1").Value = Sheets("シートA").Range("$A$1").Value End If End Sub シートBへのVBA設定 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("シートA").Range("$A$1").Value = Sheets("シートB").Range("$B$1").Value End If End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAについて
こんにちわ！ 今、エクセルでAシートの入力した項目をBのシートへデーターが入力できるようなシステムを以下のようにくみました。 そこでBシートにデーターが入力されるのですが２０行まで入力すると入力できないようにしたいのですが、なかなか上手くいきません。 A1からF20まで書式のロックを外しそれ以外のセルは保護をかけたのですがその状態でVBAを使って２０行以上入力できませんという感じのエラー表示をしたいのですが、どうすればいいでしょうか？ VBAは初心者ですが宜しくお願いします。 Private Sub CommandButton1_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("date").Columns(1)) + 1 Sheets("date").Cells(row, 1).Value = Range("B2").Value row = WorksheetFunction.CountA(Sheets("date").Columns(2)) + 1 Sheets("date").Cells(row, 2).Value = Range("B3").Value row = WorksheetFunction.CountA(Sheets("date").Columns(3)) + 1 Sheets("date").Cells(row, 3).Value = Range("B4").Value row = WorksheetFunction.CountA(Sheets("date").Columns(4)) + 1 Sheets("date").Cells(row, 4).Value = Range("B5").Value row = WorksheetFunction.CountA(Sheets("date").Columns(5)) + 1 Sheets("date").Cells(row, 5).Value = Range("B6").Value row = WorksheetFunction.CountA(Sheets("date").Columns(6)) + 1 Sheets("date").Cells(row, 6).Value = Range("B7").Value Sheets("統制入力").Select Range("B17").Select ActiveWindow.SmallScroll Down:=-9 Range("B3:B7").Select Selection.ClearContents Range("B1").Select End Sub
- ベストアンサー
- Visual Basic
- コンボボックスのvba 作成の仕方
私は、月別にデータを作っています。なので、月ごとにデータを見られるようなボタンを作成したいです。 現在組んでいるマクロは、ボタン（普通の四角いもの）を押すごとに、翌月データをコピペするというものになっています。 （以下、現在のコード記載） Sub auto_open() Dim wkm As Long Dim wkn As Long Dim wkt As Variant Dim wks As Variant Dim dt As Date Dim mi As Integer dt = Date mi = Month(dt) wkt = Array(0, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9) wks = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) wkm = wkt(mi) Call Macro1(wkm) Sheets("住宅資金").Range("A3") = wks(mi) End Sub Sub Next_Month() Dim wks As Variant Dim dt As Date Dim mi As Integer wks = Array(0, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9) If Sheets("住宅資金").Range("A3") = 12 Then wkm = 10 Else wkm = wks(Sheets("住宅資金").Range("A3") + 1) End If Call Macro1(wkm) wks = Array(0, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3) Sheets("住宅資金").Range("A3") = wks(wkm) End Sub Sub Macro1(ByVal wkm As Long) With Sheets("入力") Sheets("住宅資金").Range("D5:D23").Value = .Range("C5:C23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("J5:J23").Value = .Range("C28:C46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("P5:P23").Value = .Range("T28:T46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("O5:O23").Value = .Range("T5:T23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("F5:F23").Value = .Range("O5:O23").Value Sheets("住宅資金").Range("L5:L23").Value = .Range("O28:O46").Value End With With Sheets("目標") Sheets("住宅資金").Range("C5:C23").Value = .Range("B4:B22").Offset(, wkm - 1).Value Sheets("住宅資金").Range("I5:I23").Value = .Range("B27:B45").Offset(, wkm - 1).Value End With With Sheets("前年同期") Sheets("住宅資金").Range("H5:H23").Value = .Range("C5:C23").Offset(, wkm - 1).Value Sheets("住宅資金").Range("N5:N23").Value = .Range("C28:C46").Offset(, wkm - 1).Value Sheets("住宅資金").Range("Q5:Q23").Value = .Range("T5:T23").Offset(, wkm - 1).Value End With End Sub さて、現在作りたいと思っているものを以下に記述します。 普通の四角いボタンではなく、コンボボックスを使用して、矢印（▼）を押すことによってリストが表れ、 「1月」に合わせたら1月のデータがコピペされる、「8月」に合わせたら8月のデータがコピペされる、というものを作りたいと思っています。 以下のような空欄の表を作成したシートがあります。 A B C D 1 目標 実績 … … 2 ○支所 3 △支所 4 ・ 5 ・ 6 ・ 別のシートに、手入力した月別のデータがあります。 空欄のシートのどこかにコンボボックスを作り、別シートの○月のデータを貼り付けられるようにしたいと思っています。 コンボボックスの作り方がわからず、後一歩のところでつまずいてしまいました。 知恵をお貸しください。 よろしくお願いいたします。
- 締切済み
- Visual Basic
- 毎月の値上げに嫌気がさしていませんか？今年になってから節約やコストカットを始めた人も多いのではないでしょうか。シャンプーやサプリメントなどを安いメーカーのものに変えるなどの工夫をしている人もいます。
- お金の節約方法やコスト削減のヒントを教えてください。値上げに疲れた人も多いのではないでしょうか。毎月の出費を減らすために、安いメーカーのシャンプーやサプリメントに切り替えるなどの方法があります。
- 節約とコストカットが注目される中、お金を節約する方法は何かありますか？値上げに嫌気がさしている人も多いのではないでしょうか。安いメーカーのシャンプーやサプリメントに変えるなどのアイデアがあります。
お礼
こちらを使いたいと思います。 ありがとうございました。(^^)