- 締切済み
エクセルで、テキストボックスへ入力した内容を、別シートへ一覧表にしたいです
Sheet1には、テキストボックス３つ（txtName, txtAdr, txttel）、 日付入力 用にDTPicker1、あと登録ボタンを作りました。 これに入力しては、登録ボタンを押下し、別シートに一覧表が出来るようにし たいです。 ネットで色々検索して、下のように、同じシートに一覧表が出来るまではうま くいったのですが、別シートに一覧表を作成する方法がわからないので、教え て下さいm(_ _)m 宜しくお願いします。 Private Sub cmdtouroku_Click() Dim varRag As Variant Dim myArray As Integer varRag = Array(txtName, txtAdr, txtTel, DTPicker1) Range("A65536").End(xlUp).Offset(1).Select For myArray = 0 To 3 With Selection .Offset(, myArray) = varRag(myArray) End With Next myArray End Sub
- pataliro_x
- お礼率0% (0/1)
- オフィス系ソフト
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
みんなの回答
Range("A65536").End(xlUp).Offset(1).Select ここでシートを指定していないためにアクティブシートに書き込む形となっているのでは？ ということは、頭にシート名をつけてあげれば出来そうな気がします。 試していませんので間違っていたらごめんなさい。
関連するQ&A
- Excel オーダーフォームのテキストボックス入力について
オーダーフォームを作成し、テキストボックスを2つ以上作成し、コマンドボタンを1つ作りました。 同じ行ですべてを入力できるようにしたいのですが、どうしたらよいでしょうか？ テキストボックス1の値を入力するためのコマンドは、最下位の行を探してそこに入力するようなコマンドを作っているはずです…その横の列にテキストボックス2の値を入力し、その横の列にテキストボックス3の値を入力し…というようにしていきたいのです。 Private Sub CommandButton1_Click() Dim lRow As Long With Worksheets("sheet1") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = TextBox1.Value End With TextBox1.Value = "" TextBox1.SetFocus End Sub
- ベストアンサー
- オフィス系ソフト
- ￥マークがダブります。
Private Sub CommandButton4_Click() Dim varRag As Variant Dim myArray As Integer varRag = Array(TextBox1, TextBox2) If TextBox1 <> Empty Then '初めて入力される場合は、最初の行を選択します。 If Range("A16") = Empty Then Range("A16").Select TextBox1 = TextBox1.Value For myArray = 0 To 1 With Selection .Offset(, myArray) = varRag(myArray) End With Next myArray Else '2回目以降の入力であれば最終行の1行次の行を選択します。 Range("A65536").End(xlUp).Offset(1).Select For myArray = 0 To 1 With Selection TextBox1 = TextBox1.Value TextBox2 = "￥" & TextBox2.Value .Offset(, myArray) = varRag(myArray) End With Next myArray End If 'テキストボックスをすべて初期化します。 TextBox1 = "" TextBox2 = "" TextBox1.SetFocus Else 'テキストボックスに名前を入力しないで登録を押した時に出すエラーメッ セージです。 MsgBox "科目を入力して下さい。" End If End Sub ********************************************************************* 上記のコードですが、ワークシートに転記すると、￥マークが二つ表示されま す。 '2回目以降の入力であれば最終行の1行次の行を選択します。 Range("A65536").End(xlUp).Offset(1).Select For myArray = 0 To 1 With Selection TextBox1 = TextBox1.Value TextBox2 = "￥" & TextBox2.Value ↑ ↑ 上記部分を消すと、テキストのみの内容で、￥マークは表示されません。どこ が間違っているのでしょうか。
- ベストアンサー
- オフィス系ソフト
- ExcelシートをCSVファイルにする
Excel2000を使用してます。 Excelブックに３つのシートがあります。 シート１はメインシートとして「ボタン1」「ボタン2」が存在してます シート２はインプットデータ用シート シート３はアウトプットデータ用シートです シート１の「ボタン1」を押すとVBAが実行されシート２の情報を読み、 シート３に算出結果を出力する仕組みです。 次にシート１の「ボタン2」を押すとシート３の内容をCSVに出力したいのですが、 下記のロッジクではうまくいきません。 どこを修正すればよいのでしょうか？ Sub CSV出力() Dim ONAME As String Dim しーと As Worksheet Dim 新しーと As Worksheet Dim PAS As String 'OUTパス名 PAS = ThisWorkbook.Path ONAME = PAS & "\" & "出力.CSV" '出力しーと Sheets("出力").Select Set しーと = ActiveSheet Set 新しーと = Worksheets.Add With 新しーと しーと.Copy .Move End With With ActiveWorkbook .SaveAs Filename:=ONAME, FileFormat:=xlCSV .Close False End With End Sub
- ベストアンサー
- その他（プログラミング・開発）
- 特定の文字以外を入力すると別シートに表記する方法
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim StrRow As Long Dim TgtCol As Long Dim MaxRow As Long Dim ChgRow As Long Dim PutSh1 As Worksheet Dim PutSh2 As Worksheet Dim PutSh3 As Worksheet Dim PutCol As Long Dim PutRow As Long Dim ChgRng1 As Range Dim ChgRng2 As Range Dim ChgRng3 As Range StrRow = 5 MaxRow = 35 If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub Set PutSh1 = ThisWorkbook.Sheets("Sheet2") Set PutSh2 = ThisWorkbook.Sheets("Sheet3") Set PutSh3 = ThisWorkbook.Sheets("Sheet4") With ThisWorkbook.Sheets("Sheet1") Set ChgRng1 = Range(.Cells(StrRow, 3), .Cells(MaxRow, 3)) 'C列 Set ChgRng2 = Range(.Cells(StrRow, 5), .Cells(MaxRow, 5)) 'E列 Set ChgRng3 = Range(.Cells(StrRow, 7), .Cells(MaxRow, 7)) 'G列 End With ChgRow = Target.Row If Not Intersect(Target, ChgRng1) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh1, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng2) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh2, ChgRow, Target.Value End If If Not Intersect(Target, ChgRng3) Is Nothing Then Target.Offset(0, -1).Value = Target.Offset(0, -1).Value + 1 DataPut PutSh3, ChgRow, Target.Value End If End Sub 以前質問させて頂いた内容で追加の質問です。 Sheet1の指定したセルに「ー（ハイフン）」の文字がある時は、Sheet2〜4に転送（表記）しない方法を追加する場合はどの様にすれば宜しいでしょうか？
- ベストアンサー
- Excel（エクセル）
- コンボボックスから検索するVBA（エクセル）
sheet１にメニュー画面 sheet２に一覧表を作成しました。 (1)sheet１でユーザーフォームを起動させる。 (2)ユーザーフォームにはコンボボックスを1つ、コマンドボタンを2個配置しました (3)コンボボックスのプルダウンメニューはsheet２の一覧表より取得しました (4)sheet２の一覧表は今後データが増えていきます（データは４行目以降） という条件で以下のコードを作成しました。 (1)と(2)のコマンドボタンは正常に作動しています。 コンボボックスのコードのみ書いています。 Private Sub UserForm_Initialize() Dim i As Long With Worksheets("sheet2") For i = 4 To .Cells(Rows.Count, 3).End(xlUp).Row ComboBox1.AddItem Cells(i, 3).Value Next i End With End Sub このときプルダウンメニューを押しても空欄が表示されてしまいます。 できない理由が分かりません。よろしくお願いします。 また、Private Sub ComboBox1_Change()とは何が違うのでしょうか？ 最近 VBAを始めた初心者です。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- リストボックスの内容を検索したいが...
エクセル2019を使っています。 添付画像のようにユーザーフォームにテキストボックスとリストボックスを作り、テキストボックスに入力した文字でリストボックスの内容を検索しようとコードを作成しました。 Private Sub TextBox1_Change() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").AutoFilter 1, "*" & TextBox1.Value & "*" If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then Set rng = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible) Else Me.ListBox1.Clear Exit Sub End If End With Me.ListBox1.Clear With Me.ListBox1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With End Sub Private Sub UserForm_Initialize() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rng = .Range("A2:A" & LastRow) End With With Me.ListBox1 .ColumnCount = 1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With ListBox1.ListIndex = 0 End Sub とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。
- ベストアンサー
- Excel（エクセル）
- リストボックスからの入力をテキストに貼付
下記コードではリストボックあ行選択しテキスト1～6に入力後、クリアボタンで消去したあと、か行選択しテキストに入力したら7～貼付けになるクリアボタンで消去後、改めてテキスト1～入力するコードがありますか。どなたか解る方よろしくお願いします。 Private Sub 実行_Click() Static cnt As Integer Dim i As Integer If Listbox.ListIndex = -1 Then Exit Sub For i = 0 To Listbox.ListCount - 1 If Listbox.Selected(i) Then cnt = cnt + 1 If cnt > 10 Then cnt = 1 Me.Controls("TextBox" & cnt).Text = Listbox.List(i) End If Next End Sub Private Sub クリア_Click() Dim tbCont As Control With Me.MultiPage1 For Each tbCont In .Pages(.Value).Controls If TypeName(tbCont) = "TextBox" Then tbCont.Value = Null End If Next tbCont End With End Sub
- ベストアンサー
- Visual Basic
- マクロ！一覧から別シートへの抽出
商品の納期や、集金日などが一覧になっている【一覧】シートがあります。 他に集金月別にシート【4月】【5月】…と一年分12シートあります。 一覧シートは、空欄セルに店舗名や納期などを随時入力していき、データは増えていくのみです。 下記のマクロでデータの抽出・抽出結果のコピー・貼り付けを行っています。 Sub Macro4() ' ' Macro4 Macro ' 集金月で抽出 Dim myRow1 As Long, myRow2 As Long myRow1 = Sheets("一覧").Range("B65536").End(xlUp).Row myRow2 = Sheets("4月").Range("B65536").End(xlUp).Row If myRow2 >= 3 Then ★ Sheets("4月").Range("A3:P" & myRow2).ClearContents End If Sheets("一覧").Range("A3:P" & myRow1).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("G1:H2"), CopyToRange:=Range("A4:P4"), Unique:=False End Sub 一覧以外のシート全てに、上記マクロを登録した【抽出】ボタンを設置し G1:H1セルには集金日と検索項目のタイトル G2セルには>=4/1、H2セルには<=4/30 抽出ボタンをクリックして一覧から取得しています。 マクロは、説明が載っているHPからの独学なのでどう応用すれば良いのかがわかりません。 一覧に追加入力し、4月シートに4月分抽出。次に5月シートに5月分抽出とすると4月シートの抽出結果が消えてしまいます。 そこで、★で指定している4月シートではなく、現在選択している”シート”としたいのですが、どのように記述すればよいかわかりません。 自分が分からない事を、どう検索してよいかも分からなくなってきたので、どうかアドバイスお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA 別シートの最終行に追記
ExcelのSheet1で作成した表の一部項目を、Sheet2に一覧表としてまとめたいのです。 例えばSheet1にアンケート項目のような入力されていて、毎日使いまわします。 セルA1： 訪問日→固定 セルB1： （日付）→更新 セルA3： お客様指名→固定 セルB3： （氏名）→更新 使いまわすので、1度入力されたものは、Sheet2に一覧表として転記しておきたいのです。Sheet2の一覧表の最終行をみつけて追記していきたいです。 書いてみたのは以下の通り。 Private Sub 登録ボタン_Click() Dim SH1 As Worksheet, SH2 As Worksheet Dim GYO As Long Set SH1 = ThisWorkbook.Worksheets("回答内容") Set SH2 = ThisWorkbook.Worksheets("情報シート") ' Sheet2の最終行を取得 GYO = SH2.Range("$A$65536").End(xlUp).Row ' 最終行の次行を取得 If SH2.Cells(GYO, 1).Value <> "" Then GYO = GYO + 1 ' 現在の収容位置の下に転記 SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$c$2:$D$10").Value With SH1 .Range("A3").Copy Destination:=SH2.Range("A2") .Range("B3").Copy Destination:=SH2.Range("B2") End With End Sub 項目は飛び飛びのセルに入力されていて、それらをまとめて一覧表の1行にまとめたいと思っています。 ここでは例としてSheet1[A3][B3]セルをSheet2へ転記していますが、項目はもっといっぱいあります。 記載したコードで実行すると、1回目は転記されますが、2回目以降が追記されていきません。 ' 現在の収容位置の下に転記 のところに問題があると思っています。 全くの初心者が、コードを書くのには無理があると思いますが、どなたか教えていただけないでしょうか。宜しくお願いします。
- 締切済み
- その他（プログラミング・開発）
- エクセル VBA リストボックス 一覧処理
エクセル VBA リストボックス 一覧処理 シートから文字列を検索 ↓ リストボックス表示 ↓ 表示結果をクリック ↓ 空欄時入力 ↓ 更新 上記の流れをVBAで行いたいのですが、結果表示されたリストを選択 詳細を表示し、空欄においては都度入力した物を更新ボタンでセルへ 反映させるにはどの様にすればいいのでしょうか？ Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim SAGASU As Object Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set SAGASU = Worksheets("2月") MaxRows = SAGASU.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = SAGASU.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub --------------- Private Sub UserForm_Initialize() Set SAGASU = Worksheets("2月") Maxl = SAGASU.UsedRange.Rows.Count End Sub --------------- Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Namae = TextBox1.Text Set MeNamae = KensakuForm Call 検索(Namae, MeNamae) End Sub ---------------- Private Sub CommandButton2_Click() End End Sub ---------------- Private Sub ListBox1_Click() ListIdx = ListBox1.ListIndex Namae = ListBox1.List(ListIdx) End Sub 文字数制限の為、一部抜いていま
- 締切済み
- オフィス系ソフト
