- 締切済み
VBAについて
現在マクロ勉強中です。 教えて頂きたいのは、登録ボタンで指定セルの台帳への転記する方法です。 Private Sub cmdToroku_Click() Dim myrow As Integer Option Explicit With ActiveSheet If .Range("A4").Value = "" Then myrow = 1 Else myrow = .Range(Cells(.Rows.Count, 1).End(xlUp).Address).Row + 1 End If .Cells(myrow, 1).Value = TextBox1.Value End With End Sub 上記ですと、開いているシートのA1に入力されてしまいます。 別シートへ転記したい場合どのあたりを修正すればよいのでしょうか? お力お借りできれば幸いです。
- mint-choco
- お礼率18% (5/27)
- Excel(エクセル)
- 回答数3
- ありがとう数6
- みんなの回答 (3)
- 専門家の回答
みんなの回答
- kybo
- ベストアンサー率53% (349/647)
以下の様に★部分を訂正してみてください。 Private Sub cmdToroku_Click() Dim myrow As Integer With Worksheets("台帳") If .Range("A4").Value = "" Then ’★台帳シートのA4で判断する myrow = 4 ’★1を4に変更(A4にしたいのなら) Else myrow = .Range(Cells(.Rows.Count, 1).End(xlUp).Address).Row + 1 End If .Cells(myrow, 1).Value = TextBox1.Value End With End Sub
- kybo
- ベストアンサー率53% (349/647)
「台帳」という名前のシートが既に同じブック内にある場合で、アクティブシートのA4の値で判断する場合。 Private Sub cmdToroku_Click() Dim myrow As Integer With Worksheets("台帳") If ActiveSheet.Range("A4").Value = "" Then myrow = 1 Else myrow = .Range(Cells(.Rows.Count, 1).End(xlUp).Address).Row + 1 End If .Cells(myrow, 1).Value = TextBox1.Value End With End Sub
- eden3616
- ベストアンサー率65% (267/405)
「'★」を最後につけている箇所になります。 「シート名」に実際のシート名を入力してください。 With ○○ ~ End Withブロックはこの間に記述された構文において 「.Range("A1")」のように先頭にピリオド「.」を記述することで ○○より手前のオブジェクトを省略して記述することが出来ます。 ここで「Activesheet(現在アクティブなシート)」が省略されていますので「.Range」や「.Cells」は 「Activesheet.Range」や「Activesheet.Cells」と記述するのと同意になります。 Private Sub cmdToroku_Click() Dim myrow As Integer Option Explicit With Sheets("シート名") '★ If .Range("A4").Value = "" Then myrow = 1 Else myrow = .Range(Cells(.Rows.Count, 1).End(xlUp).Address).Row + 1 End If Cells(myrow, 1).Value = TextBox1.Value End With End Sub
関連するQ&A
- excel VBA コンボボックスでシート選択後エラー
どなたかご教授願います。 ユーザーフォームにコンボボックスを配置し、ブック内のシートすべて選択できるようにしてます。選択後シートに移動するのですが、同じユーザーフォームのテキストボックス等に入力した後、コマンドボタンをクリックするとエラーとなります。しかしテキストボックス等の値は間違いなく入力されています。よろしくお願いします。 Private Sub ComboBox1_Change() → Sheets(Me.ComboBox1.Value).Select この部分が黄色になってしまいます End Sub Private Sub CommandButton1_Click() Dim myRow As Long ActiveSheet.Select myRow = Range("B65536").End(xlUp).Offset(1, 0).Row '各テキストボックの値をセルに入力 Cells(myRow, 2).Value = TextBox1.Value Cells(myRow, 3).Value = TextBox1.Value Cells(myRow, 4).Value = ComboBox2.Value Cells(myRow, 6).Value = TextBox2.Value Cells(myRow, 7).Value = TextBox3.Value Cells(myRow, 8).Value = TextBox4.Value 'Cells(myRow, 9).Value = TextBox5.Value '書式設定 Cells(myRow, 2).NumberFormatLocal = "m" Cells(myRow, 3).NumberFormatLocal = "dd" Cells(myRow, 6).NumberFormatLocal = "#,###" 'セルに入力が各テキストボックの値をクリア ComboBox1.Value = "" ComboBox2.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" 'フォーカス移動 ComboBox2.SetFocus End Sub
- ベストアンサー
- Visual Basic
- excel VBA リストボックス複数選択後の処理
どなたか教えてください。 Sheet1にユーザーフォームを使用しデータを入力しています。 リストボックスが複数選択した後にコマンドボタンをクリックした際、 選択項目を1行のセル[Cells(myRow, 16)~Cells(myRow, 20)]に左詰めで表示したい場合はどのようにするのでしょうか? 例:リストボックスには10項目あるとして、そのうち1行目、3行目、5行目だけが選択された場合のパターンで、1行目がCells(myRow, 16)、3行目がCells(myRow, 17)、5行目がCells(myRow, 18)に表示したいのですが・・・。 最大5項目選択とみています。 ※コマンドボタンは他のTextBox等も含まれ、下記のような感じです。 Private Sub CommandButton1_Click() Dim myRow As Long Sheets("Sheet1").Select myRow = Range("A65536").End(xlUp).Offset(1, 0).Row '各テキストボックの値をセルに入力 Cells(myRow, 1).Value = TextBox1.Value Cells(myRow, 2).Value = TextBox2.Value Cells(myRow, 3).Value = ComboBox1.Value Cells(myRow, 4).Value = TextBox3.Value Cells(myRow, 5).Value = TextBox4.Value . . . Cells(myRow, 16).Value = Cells(myRow, 17).Value = Cells(myRow, 18).Value = . . . 'セルに入力が各テキストボックの値をクリア TextBox3.Value = "" TextBox4.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" 'フォーカスをTextBox3に移動 TextBox3.SetFocus End Sub
- ベストアンサー
- Visual Basic
- このVBAコードの解説をお願いします。
特定の行の中で同じものが続いたらセルを結合する、ということがやりたくて 以下のコードをネット上から探してきました。 上記の動作は実現できたのですが、自分でこのコードをみてもイマイチわかりません。 お分かりになる方、できれば1行ずつ解説してください。 よろしくお願いします。 Sub Sample() Dim myRng As Range, myRow As Long Set myRng = Range("A1") For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row With Cells(myRow, 1) If .Value = .Offset(1).Value Then Set myRng = Union(myRng, .Offset(1)) Else Application.DisplayAlerts = False myRng.Merge Application.DisplayAlerts = True Set myRng = .Offset(1) End If End With Next End Sub
- 締切済み
- オフィス系ソフト
- 【EXCEL】UserFormで入力して 重複したデータがあった場合 上書きかキャンセルかを表示させたい。
現在 Userformで入力して 末行に 登録され 並び替えするだけの マクロをやってます。 これだと同じ商品コードがあった場合 重複されてしまいます。ここで上書きされるようにするにはどうやったらいいのでしょうか? また 重複しています 上書きしますか?という警告表示は出せないでしょうか。よろしくお願いします。 A B 1 商品コード 名前 2 2986 AAAA 3 2987 BBBB 4 2988 cccc 5 2989 dddd 現在の userform のコード Private Sub CommandButton1_Click() Dim cord As String Dim syouhinnmei As String cord = TextBox1.Value syouhinmei = TextBox2.Value If cord = "" Then MsgBox "商品コードを入力してください" Exit Sub End If If syouhinmei = "" Then MsgBox "商品名を登録してください" Exit Sub End If myRow = Worksheets("Sheet1").Cells(65536, 2).End(xlUp).Row + 1 With Worksheets("Sheet1") .Cells(myRow, 1).Value = cord .Cells(myRow, 2).Value = syouhinmei End With Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then _ myCtrl.Value = vbNullString Next Sheets("Sheet1").Select Range("A1:B1").Select Range("A1:B2000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal Sheets("Sheet2").Select Range("A1").Select End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで最小値を求めたいのですが
下記はある表の最大値を求めるものですが 同様の条件で最小値を求めようと思い 「MAX」の箇所を「MIN」差し替えてできると思っていたのですが 最小値がのかわりに「0」が表示されてしまいます。 そのように修正すればよいでしょうか? private sub worksheet_change(byval Target as excel.range) if target.cells(1) = "" then exit sub if target.address = "$A$1" then Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With elseif target.address = "$E$1" then Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With end if end sub
- ベストアンサー
- オフィス系ソフト
- excel ユーザーフォームでシートごとに転記2
先日ユーザーフォームへの転記について質問させていただきました。 ご回答いただき、ありがとうございました。 今度はオプションボタンで選択したときに、シートごとに転記する方法を 教えていただけますでしょうか。 ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート1へ転記 OptionButton2・・・シート2へ転記 これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」 と出てしまいます。 どなたかご教示願います。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBAの検索について
Excelシートに表の一覧があり、項目(5行目)のところでウィンドウの固定をしています。 検索したいNo.をセル(G2)に入力し、コマンドボタンをクリックします。 セル(G2)に入力されたNo.とA列に入力されているNo.が一致する行を検索し、一致した行(複数はない)を項目の下までスクロールさせた状態で表示したいと思っています。 検索までは下記プログラムでできているのですが、一致した行を項目の下までスクロールさせた状態で表示するのはどうしたらよいのでしょうか。 ************************************************************* Private Sub CommandButton1_Click() Dim myClm As Integer, myFind As Integer, myRow As Integer myClm = 1 'A列 If Sheet1.Range("G2") = "" Then Exit Sub myFind = Sheet1.Range("G2") For myRow = Cells(Rows.Count, myClm).End(xlUp).Row To 1 Step -1 With Cells(myRow, myClm) If .Value Like myFind Then .Activate Exit For End If End With Next End Sub ************************************************************
- ベストアンサー
- Visual Basic
- 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
- ベストアンサー
- オフィス系ソフト
- エクセルVBAについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを E列に日付 F列に売上 G列に結果 でやりたいのですが この時A列~C列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか?
- ベストアンサー
- オフィス系ソフト
- エクセルVBAの転記について
エクセル2013VBAで最終行を取得しての転記が上手くいきません。どのようにすれば良いかご教授ください。 簡単なサンプルを下記します。 Sub サンプル入力からのDBへの転記() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim myRow As Long Set Sh1 = Worksheets("サンプル入力") Set Sh2 = Worksheets("サンプルDB") With Sh2 myRow = Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & myRow).Value = Sh1.Range("D4").Value .Range("B" & myRow).Value = Sh1.Range("F4").Value End With End Sub 入力内容を変えないテストでは (1)実行するとDBへの転記は問題なく出来ます。 (2)継続してマクロを実行しても問題なく転記が行われ、同じデータが蓄積されていきます。 入力内容を変更して引き続きマクロを実行すると挙動不審に陥ります。 現象としては (1)初めの行に何度も重ねて転記を行う。 (2)空白行を作り、その行に何度も転記を行ってしまう。 (3)空白行を作り、それ以降転記を実行し蓄積を行ってしまう。 入力シートには結合セル、リストを使用していますが、原因究明を行う中でこれが原因とは思えませんでした。 これがクリアできないと先に進めません。ぜひお力を貸してください。 宜しくお願い申し上げます。
- ベストアンサー
- Windows 8
補足
ご回答ありがとうございます。 続けて質問させて下さい。 台帳と書かれたシートには転記されたのですが、値がA4に入ってくれませんでした。 A1に入ってしまいます。これはまだ異なるところがあるのでしょうか? ユーザーフォーム起動→そこに入力した値が台帳というシートのA4セルに転記をさせたいのが 今回のやりたいことなのですが、ユーザーフォームのテキストボックスの転記先が違う等でしょうか?