- ベストアンサー
エクセルVBAシートの選択方法
GOCHISOUdaの回答
- GOCHISOUda
- ベストアンサー率34% (50/144)
If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value がなければ動きますよ。 Worksheets("Sheet1").Range("C2").Value = Target.Value でC2の値がなしになっているのでは？
関連するQ&A
- エクセル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 実行時エラー'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です。
- ベストアンサー
- オフィス系ソフト
- ＥＸＣＥＬのＶＢＡですが。
ＥＸＣＥＬのＶＢＡですが。 Sub macro1() Dim mycnt As Integer Dim sheet_name1 As String Sheets("kekka").Select Range("A1").Select Sheets("shiji").Select mycnt = Range("B1").Value sheet_name1 = Range("c" & mycnt) Sheets("kekka").Select Sheets("kekka").name = sheet_name1 Sheets("kansuke").Select Sheets("kansuke").Copy Before:=Workbooks("2007年報告.xls").Sheets(3) End Sub （やりたいこと） B1に入っている数値でＣ１からC10に入っているあるシートの名前(たとえばkansukeとする）を取り、その名前で kekkaというシート名をkansukeという名前に変える。 名前を変えたkansukeというシートを別の2007年報告というbookにコピーを転送する。 (質問）上のコードで実はkansukeと書いてあるところは，Ｂ１の値次第で当然いろいろに 変化するため、そのシート名にとらわれない書き方をしたいのですがどう記述すればいいのか わかりません。以上お願いします。
- ベストアンサー
- Visual Basic
- ExcelのVBAについてです。シート1と2を作成
ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか？ '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。（コード） s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub
- ベストアンサー
- その他（プログラミング・開発）
- Excel Select Case で変数を使うと表示されない。
Sub test1() Dim Fruits As String Dim Iro As String Sheets("Sheet1").Select Fruits = Range("A1").Value Iro = Range("B1").Value Select Case Fruits Case Is = "みかん" Iro = "オレンジ" End Select End Sub とすると、何の反応もありませんが、 Iro = "オレンジ" の箇所を Range("B1") = "オレンジ" とするときちんと表示されます。 なぜ変数ではダメなのでしょうか？
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAについて(再掲)
ExcelのVBAについて(再掲) 以下のシートは作成中(勉強中)のものです。いずれは私的に実用しようと思っています。。 さて、質問ですが、「シート1のA3に入力、手動でシート2に移動自動で転記し、手動でシート1に移動し、また入力する」という単純動作を目的に作成しています。問題点は沢山ありますが、例えば『シート1の時間列が何かの変更で書き換えられてしまう』、『沢山書いていくと分かりますが、途中で行削除を行うと、時間列に削除行分の時間記録が下向きに書き込まれる』などです。他にもあると思っていますが、(1)この問題はなぜ発生するのか？(2)修正案としてはどの様な例があるか？ 等をお聞きしたいです。細々と問題はあると思っていますので、その様な問題点もお聞きしたいです。 よろしくお願いします！ '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") Application.EnableEvents = False Application.EnableEvents = True End If Next time7 Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() Application.Goto ActiveSheet.Range("A3"), True Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Application.Goto ActiveSheet.Range("A3"), True Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove Sheets("Sheet2").Range("A3").Select End Sub
- ベストアンサー
- その他（プログラミング・開発）
- ExcelのVBAについて(勉強中のです。)
ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか？ データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった？ ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub
- 締切済み
- その他（プログラミング・開発）
- VBA シート間の同期（列、行、選択範囲）
初めての質問となります。 よろしくお願いいたします。 シート間の同期でセルの同期は他の質問を参照してできましたが、 ”行”や”列”での同期/相互参照は、どのように書けばいいのでしょうか。。 下記、sheet1”A1”とsheet2の”B1”に記載したcodeです。 'sheet1に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("Sheet2").Range("$B$1").Value = Sheets("Sheet1").Range("$A$1").Value End If End Sub 'sheet2に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("Sheet1").Range("$A$1").Value = Sheets("Sheet2").Range("$B$1").Value End If End Sub 【質問内容】 sheet1の”A列”とsheet2の”B列”はどう書くのでしょう？ 上記の方法では無理、または負荷が大きい場合は、 sheet1の”A1:C3”とsheet2の”D4:F6”はどう書くのでしょう？ という内容になります。 先日からVBAを触り始め、 自分なりに調べて一通り試してみましたが解決できませんでした。。 お手数おかけしますが何卒よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL、VBAについて
' GLOBAL変数の定義 Dim CurrentDir As String '現在のディレクトリ Dim ThisBook As String '現在のブック名 Dim WorkSheetName1 As String Dim WorkSheetName2 As String Dim ConfigSheetName As String Dim ListSheetName1 As String Dim ListSheetName2 As String Dim ListSheetName3 As String Dim ListSheetName4 As String Dim ListSheetName5 As String Dim ListSheetName6 As String Dim ListSheetName7 As String Dim ErrorFlag As Integer 'エラーフラグ 0:正常 1:エラー Sub 初期設定() CurrentDir = ActiveWorkbook.Path '現在のディレクトリ ThisBook = ActiveWorkbook.Name '現在のブック名 WorkSheetName1 = "work1" WorkSheetName2 = "work2" ConfigSheetName = "設定" ListSheetName1 = "****" ListSheetName2 = "****" ListSheetName3 = "****" ListSheetName4 = "****" ListSheetName5 = "****" ListSheetName6 = "****" ListSheetName7 = "****" Application.DisplayAlerts = False 'EXCELの警告を無視する End Sub Sub CSV取り込み() Dim LoadBook As String '読み込みブック名 Dim DataMaxCol As Integer '読み込みデータ有効最大カラム数 Dim WorkStartRow As Integer 'workシート開始行 Dim WorkEndRow As Integer 'workシート終了行 Dim ListMaxCol As Integer '一覧シート有効最大カラム数 Dim ListStartRow As Integer '一覧シート開始行 '初期設定コール Call 初期設定 'workシートをクリア DataMaxCol = Sheets(ConfigSheetName).Range("F2").Value WorkStartRow = Sheets(ConfigSheetName).Range("F3").Value WorkEndRow = Sheets(ConfigSheetName).Range("F4").Value Sheets(WorkSheetName1).Select Range(Cells(WorkStartRow, 1), Cells(WorkEndRow, DataMaxCol)).ClearContents '受注データファイルを選択しオープン SelectedPath = Application.GetOpenFilename("CSVファイル (*.csv), *.csv") If SelectedPath <> "False" Then Workbooks.Open Filename:=(SelectedPath) Else 'キャンセル時は終了 Exit Sub End If LoadBook = ActiveWorkbook.Name '現在のブック名 '受注データの開始行をチェック I = WorkStartRow '受注データの最終行をチェック Do Until ActiveCell.Value = "" I = I + 1 Cells(I, 1).Select Loop WorkEndRow = I - 1 '受注データをコピー Range(Cells(WorkStartRow, 1), Cells(WorkEndRow, DataMaxCol)).Select Selection.Copy 'workシートへペースト Windows(ThisBook).Activate Sheets(WorkSheetName1).Select Range("A1").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False '受注データファイルをクローズ Windows(LoadBook).Close End Sub このマクロを実行するとインデックスが有効範囲にありませんとなりエラーとなってしまいます。 あと最後のデータファイルをクローズできればOKなのですが・・。 どこがいけないんでしょうか？
- ベストアンサー
- Visual Basic
お礼
ご回答有難う御座います!! C2に値はあります。 最初に挙げたセルと同様のものを記載しても エラーが出ます。