• 締切済み
  • すぐに回答を!

エクセル VBA リストボックスからの動きについて

エクセルでどうにかできないかと悩んでおります。 自分一人ではいいアイデアが浮かばないので皆様のお知恵を拝借いたしたく出させていただきます。 Private Sub CommandButton1_Click() With ListBox1 For i = 0 To .ListCount - 1 Windows("元データ.xls").Activate If .Selected(i) = True Then a = Cells(i + 2, 1) b = Cells(i + 2, 2) Windows("書き込みたいファイル.xls").Activate With Range("A20").End(xlDown).Offset(1, 0) .Offset(0, 0) = a .Offset(0, 2) = b という形で作っていますが、よく考えると『書き込みたいファイル』は 名前が色々変わってしまうファイルになっているので、それでも動くようにしたいのです。 上記2種類のファイル以外を閉じてしまう・・・という形は自分でも考えたのですが、 特定多数の人間が使うため、あまり制限をかけた状態では使いたくないのが現状です。 出来れば他のファイルを閉じたりしないようにしたいと思います。 皆様のお知恵をいただければ幸いと思いますので宜しくお願いいたします。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数136
  • ありがとう数0

みんなの回答

  • 回答No.1

まずはこのマクロはどのブックに記述されているのでしょうか? 元データ.xlsに存在するのであれば、ボタンをクリックする前にシートなりフォーム上なりにファイル名を記録しておく。 書き込みたいファイル.xlsに存在するのであれば、Thisworkbookを使うとか・・・ 全く関係ない話ですが、windows("書き込みたいファイル名").Activate という書き方では、該当ブックにシートが1枚ならともかく複数シートがあった場合、意図した場所にデータの書き込みが出来ない恐れがあります。 Workbooks("書き込みたいファイル名.xls").Sheets("Sheet1").Activate といった書き方のほうがよいと思います。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • エクセルVBA セルのコピー&ペーストで・・・

    A1のセルに、123 B2のセルに、456 C3のセルに、789 とある A.xlsファイルがあるとして B.xlsファイルの A4のセルに123 B4のセルに456 C4のセルに789とコピーしたいのです・・・と ここまでは出来たのですが、ここからが悩み所で、 上記の状況で、A4~C4までにはデーターが入っているので、次はその下のA5~C5までにデーターを入れたいのです。 A.xlsのデーター入力部分は一緒で、B.xlsのペースト部分は、入力していないセルの一番上にペーストしたいのです。 ちなみにちょっと作ってみましたがだめでした;; Windows("A.xls").Activate DATA = Range("A1:N100") Windows("B.xls").Activate With Cells(4, 1).End(xlDown).Offset(1, 0) = DATA(1, 1) っていうような感じで作ってみたのですが動かないです;; よろしくお願い致します

  • vba マクロの組み立て不能

    毎度お世話になります。 Sub 呼び込み() ChDir "C:\08-C\9\1k-1\m\" Dim c1 As Variant Dim ran1 As Range Set ran1 = Range("ad16: ad40") '<----- Windows("SW.xls").ActiveSheet 記録前の削除 ran1.Delete Shift:=xlShiftToLeft For i = 1 To 10 '<----- 実際には10から20です。 Workbooks.Open Filename:=ThisWorkbook.ActiveSheet.Cells(i + 10, "A") & ".xls", UpdateLinks:=3 Windows("SW.xls").Activate With Windows("SW.xls").ActiveSheet c1 = Cells(i + 10, "A") .Cells(i + 15, 30).Formula = "Windows" & "(" & Chr$(34) & c1 & ".xls" & Chr$(34) & ").Activate" ' 出来上がり例 Windows("出来高.xls").Activate とかWindows("1334.xls").Activate   End With Next i End Sub 'Sub 呼び込み() した後に時間をおいて保存に移りたいのですが Range("ad16")よりの書き込みにを '利用して保存をしたいのです。 例> Windows("出来高移動平均.xls").Activate Sub 保存() Range("AD17").Select Application.CutCopyMode = False Selection.Copy ' 実際には此処に挿入したいがマクロ組み立て不能です。 Windows("出来高.xls").Activate '<----- 実際には此処に挿入したいがマクロ組み立て不能です。 ActiveWorkbook.Save: ActiveWindow.Close End Sub

  • エクセルVBAで無限ループ

    教えてください。 以下の2つのエクセルマクロはまったく同じことをさせようとしているのですが、test02の方は.Offset(1).Activateが働かないのか、無限ループに陥ってしまいます。 単にActiveCell.という記述をWith~End Withでまとめただけなのになぜこうなるのでしょうか? Sub test01() ActiveSheet.Cells(1, 1).Activate Do While ActiveCell.Value <> "" If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(0, 1).Value = "文字" ElseIf ActiveCell.Value > 0 Then ActiveCell.Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then ActiveCell.Offset(0, 1).Value = "負数" Else ActiveCell.Offset(0, 1).Value = "その他" End If ActiveCell.Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End Sub Sub test02() ActiveSheet.Cells(1, 1).Activate With ActiveCell Do While .Value <> "" If Not IsNumeric(.Value) Then .Offset(0, 1).Value = "文字" ElseIf .Value > 0 Then .Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then .Offset(0, 1).Value = "負数" Else .Offset(0, 1).Value = "その他" End If .Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End With End Sub

  • エクセルマクロ・Cells.Find のエラー

      VBA初心者です。 ファイルA の C列 に入力されているデータが ファイルB に含まれているかどうか検索するマクロを Cells.Find を使って作ろうとしています。 データがファイルBに存在する場合は問題ありませんが存在 していない場合エラーが出て止まってしまいます。 ヘルプを見ると「セルが見つからなかった場合は、Nothingを返します」 と書かれていますが、どうもNothingとは返ってきません。 このエラーを回避する方法を教えてください。 例えばこんなマクロを組みました。  For tate = 0 To 19    Windows("ファイルA.xls").Activate    Range("C1").Offset(tate, 0).Select    データ = Range("C1").Offset(tate, 0)    Windows("ファイルB.xls").Activate    Cells.Find(データ, MatchCase:=False).Activate  Next tate 例えば最後の2行を    結果 = Cells.Find(What:=ISISDate, MatchCase:=False).Activate      MsgBox (結果)  Next tate とするとデータが含まれている場合は「True」と返ってきますが、 含まれていない場合は MsgBox が表示される前にエラーとなってしまいます。 とりあえずこのエラーを回避する方法をご存知でしたらお教えください。  

  • エクセルVBAプログラム質問 リストボックス応用

    エクセルVBAプログラムについて質問です。 リストボックスから結果をリストボックスに表示させる リストボックスを応用した内容です。 (1)今回追加したいのは、チェックボックスにチェックすることで、 期限が今月中に切れるもののみをリストボックスに表示させたいです。 (2)期限更新ボタンを押したら、3カ月プラスして延長させたいです。 期限更新したら、リストボックスの中身も更新したいです。 例(1):今日の日付 2018/9/23だとしたら、期限切れる(9月分すべて)を表示させたい。 例(2):期限(変更前)『2018/9/23』から期限(変更後)『2018/12/23』に変更 下記のプログラムで追加していきたいです。 Dim myData Private Sub UserForm_Initialize() Dim Dic, Keys, buf As String, i As Long Me.ComboBox1.Style = fmStyleDropDownList Me.ListBox1.ColumnCount = 4 Me.ListBox1.ListStyle = fmListStyleOption Me.ListBox1.MultiSelect = fmMultiSelectMulti Me.CommandButton1.Caption = "印刷" Me.CommandButton1.Enabled = False With Worksheets("DATA") myData = .Range("A1:E" & .Cells(.Rows.Count, 1).End(xlUp).Row) End With Set Dic = CreateObject("Scripting.Dictionary") On Error Resume Next For i = 2 To UBound(myData, 1) buf = myData(i, 1) Dic.Add buf, buf Next i Keys = Dic.Keys For i = 0 To Dic.Count - 1 Me.ComboBox1.AddItem Keys(i) Next i Set Dic = Nothing End Sub Private Sub ComboBox1_Change() Dim i As Long, j As Integer With Me.ListBox1 .Clear For i = 2 To UBound(myData, 1) If Me.ComboBox1.Value = myData(i, 1) Then .AddItem "" For j = 2 To 5 .List(.ListCount - 1, j - 2) = myData(i, j) Next j End If Next i End With End Sub Private Sub ListBox1_Change() Dim i As Long, cnt As Long With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then cnt = cnt + 1 End If Next i End With Me.CommandButton1.Enabled = (1 <= cnt And cnt <= 2) End Sub Private Sub CommandButton1_Click() Dim ws As Worksheet, i As Long, j As Integer, cnt As Byte Set ws = Worksheets("印刷") ws.PageSetup.PrintArea = "$I$2:$P$5" ws.Range("J2:L5,N2:P5").ClearContents With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then ws.Range("J2").Offset(0, cnt).Value = Me.ComboBox1.Value For j = 0 To 2 ws.Range("J5").Offset(j * -1, cnt).Value = .List(i, j) Next j cnt = cnt + 2 End If Next i End With Unload Me ws.PrintPreview End Sub

  • エクセルVBA系・・ 関数のSUBTOTALの絡みで・・・

    いつもいつもいつも皆様には大変お世話になっております。 早速本題ですが オートフィルターでフィルターをかけた物の 足し算はSUBTOTALですよね。 そこからが問題なのですが、 SUBTOTALででた合計をVBAでコピーして貼り付けをしたいのです。 その貼り付け場所は 別のシートになります。 ちなみに作ってみたのはこんな感じです Windows("表.xls").Activate DATA = Range("A1:N1002") With Range("B4") .AutoFilter .AutoFilter Field:=3, Criteria1:="A店" .AutoFilter Field:=2, Criteria1:=">=" & Z , _ Operator:=xlAnd, Criteria2:="<=" & V End With Windows("B表.xls").Activate Cells(7, 3) = DATA(1002, 8)  '1002のところがSUBTOTAL関数が入ってます。 これでコピーをするとB表にでて来る数字が、通常のSUMで全体を出した答えが入ってくるのです;; SUBTOTALの出た数字がほしいのです・・・;; こういったことは出来るでしょうか? 宜しくお願い致します。

  • Excel マクロでファイル名を変数に・・・

    初心者です。検索してもわからなかったので質問です。 下記のようなマクロの処理で「AAA」というファイル名のExcelに「2.xls」からデータをコピーし貼り付けています。    ・    ・ Windows("AAA.xls").Activate Rows("4:4").Select Selection.Insert Shift:=xlDown Windows("2.xls").Activate Range("C6").Select Selection.Copy Windows("AAA.xls").Activate Range("A4").Select ActiveSheet.Paste Windows("2.xls").Activate Range("C7").Select Application.CutCopyMode = False Selection.Copy    ・    ・ 今回は「2.xls」ではなく「3.xls」、「4.xls」、・・・といったように違うファイル名で同じ処理を行ないたいので「2」と指定するのではなく「(ファイル名).xls」といった形にしたいのですが、それは可能なのでしょうか。 ご意見宜しくお願いいたします。

  • Excel VBA(マクロ)処理中の画面に”お待ち下さい”を表示させたい。

     Excel2002で帳票印刷の処理を作成しました。 該当ブック(自身.xls)オープンすると最初にVBAにより帳票レイアウトの初期化を行います。(原紙.xlsをオープンし、自身のシートに貼り付けます。)この初期化の貼り付け処理が"原紙"と"自身"のシートを交互にアクティブにしている為、画面がちらついて、とても見苦しい状態です。 Sub 帳票初期化()  Workbook.Open Filename="F:\原紙.xls"  Sheets("帳票1").Select  Cells.Select  Selection.Copy  Windows("自身.xls").Activate  Sheets("帳票1").Select  Cells.Select  ActiveSheet.Paste  Windows("原紙.xls").Activate  Sheets("帳票2").Select  Cells.Select  Selection.Copy  ・・・・・・・・・(以下同様処理を8帳票程)  Windows("原紙.xls").Activate  ActiveWindow.Close  Windows("自身.xls").Activate End Sub (動作確認済み。手打鍵にて誤コマンドご容赦) この処理を”お待ち下さい”画面等で実行中だけ見えない状態にする、又は画面より見えない形で行うにはどうすれば良いでしょうか。

  • EXCEL VBA セルからファイル名を読み込む

    EXCEL VBAについての質問です 同じ処理を名前の違う複数のファイルで行いたいと思っています そこで、セルA2へファイル名の『○○.xls』○○部分だけをそれぞれのファイルに書き込んでおき、マクロは共通にしてファイル名をそれぞれのファイルから読み込んで実行したいと思っています。 良い方法を教えてください。 Workbooks("200809.csv").Activate Sheets("200809").Select Range("C3:C33").Copy Windows("○○.xls").Activate'←ここをファイルにあわせて変更できる形にしたい Sheets("報告書").Select Range("G5:G35").Select ActiveSheet.Paste Windows("200809.csv").Activate Range("K3:K33").Copy Windows("○○.xls").Activate’←ここ Sheets("報告書").Select Range("I5:I35").Select ActiveSheet.Paste Workbooks("200809.csv").Close SaveChanges:=False よろしくお願いします。

  • エクセルでのリストボックスの値の取得

    早速ですが、エクセルでユーザーフォーム上にある リストボックスの複数選択した時の値の取得方法を教えてください。 具体的にはアンケート集計をするためのフォームで "Q6"というワークシートのA列に「項目名」、B列に「数」を 1行目から設定しています(「数」の初期値は"0"です)。 ユーザーフォームのリストボックスにはA列を表示させています。 そのユーザーフォーム上にあるコマンドボックスに 下記のようにコード記述しても、一番上の選択されたものしか"Q6"に 反映されません(2,3,4行目を選択しても2行目の「数」のみ+1になる)。 Private Sub CommandButton1_Click()  For n = 0 To ListBox1.ListCount - 1   If ListBox1.Selected(n) = True Then    Worksheets("Q6").Cells(n + 1, 2) = _    Worksheets("Q6").Cells(n + 1, 2) + 1   End If  Next n End Sub エクセルは97で、リストボックスのMultiSelectはMultiでもExtendedでもダメでした。 どなたかご存知の方がいらっしゃいましたらよろしくお願いします。