回答数
気になる
-
ExcelのVBAコードについて教えてください。
作業ブックのシート名「省エネ質疑」 に下記のコードを設定しております。 Private Sub Worksheet_Change(ByVal Target As Range) Sheets("F設計").Visible = [$F$18] = "フラット設計審査_標準計算" Sheets("F設計").Visible = [$F$18] = "フラット設計審査_仕様基準" End Sub セル「F18」に"フラット設計審査_標準計算"又は"フラット設計審査_仕様基準" が表示されると 非表示シート名「"F設計"」が表示されるように設定しておりますが、 セル「F18」に"フラット設計審査_仕様基準"を表示させたときは非表示シート「"F設計"」が表示されますが セル「F18」に"フラット設計審査_標準計算"を表示させたときは非表示シート「"F設計"」が表示されません。 文字等の確認は全て問題ありません、 又、 一つ一つ Private Sub Worksheet_Change(ByVal Target As Range) Sheets("F設計").Visible = [$F$18] = "フラット設計審査_標準計算" End Sub 又は Private Sub Worksheet_Change(ByVal Target As Range) Sheets("F設計").Visible = [$F$18] = "フラット設計審査_仕様基準" End Sub を設定するとそれぞれ上手、非表示シートが表示されます。 両方のコードを設定すると上手く行きません。 この問題を解決できる方法を教えてください。 宜しくお願い致します。
質問日時: 2024/03/18 17:57 質問者: エクセル小僧
回答受付中
1
0
-
ExcelのVBAです。フォルダ内の全ファイルに、各ファイルの最初のシートを12か月分コピー
フォルダの中に入っている複数のエクセルファイルに、 各ファイルの一番左(または一番右)にあるシートをコピーし、 各ファイル内に12か月分のシート(12枚のシート)を追加で作成したいと思います。 202404、202405、202406・・・ のようにシート名を付けて、フォルダ内にあるすべてのファイルに対して 上記の処理を行うVBAは可能でしょうか。
質問日時: 2024/03/18 14:44 質問者: カチカチ山の狸
回答受付中
3
0
-
急にEXCELのVBAで写真の貼り付けができなくなりました。誰か教えてください。
Private Sub CommandButton1_Click() CommandButton1.Caption = "大きさの変更" CommandButton1.WordWrap = True CommandButton1.AutoSize = True Image1.AutoSize = True End Sub Private Sub CommandButton2_Click() CommandButton2.Caption = "削除" Sheets("写真").Select Range("a24").Select Application.Dialogs(xlDialogDeleteFormat).Show End Sub Private Sub Image1_Click() Sheets("写真").Select Range("a4").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub Private Sub Image2_Click() Sheets("写真").Select Range("a26").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub Private Sub Image3_Click() Sheets("写真").Select Range("a48").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub Private Sub Image4_Click() Sheets("写真").Select Range("a71").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub Private Sub Image5_Click() Sheets("写真").Select Range("a92").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub Private Sub Image6_Click() Sheets("写真").Select Range("a114").Select Application.Dialogs(xlDialogInsertPicture).Show With Selection.ShapeRange .Height = 246.75 .Width = 345.75 End With End Sub エラー箇所 With Selection.ShapeRangeです。
質問日時: 2024/03/17 18:22 質問者: runva
回答受付中
0
0
-
CADシステムに図面番号を入力してドキュワークスに落とす作業を行っています。 CADシステムには1個
CADシステムに図面番号を入力してドキュワークスに落とす作業を行っています。 CADシステムには1個ずつしか図面番号を入力できないため図面の数が多いと時間がかかってしまいます。これをエクセルに必要なデ-タを入力し自動化できないかと考えています。 PowerAutoMateDesktopというPPAツールを使ってできないか検討中です。 以下がこの作業の流れです。 1.エクセルファイルを開く(A1から下に順番に図面番号が記入してある) まずはA1をコピー 2.すでに開いているCADシステムのファイル名という項目をダブルクリック、その後そこに貼り付け 4.図面番号入力後、新規検索というボタンを左クリック 5.下の方にファイル名という項目がありそこに図面番号が表示されるのでここを右クリック 6.SXロードの項目が表示されるので左クリック 7.リボンに2D3D表示が出るので左クリック 8.ファイル範囲出力をクリック 9.プロッタ名ドキュワークスプリンターをクリック 10.用紙サイズ指定、倍率自動をクリック 11.印刷をクリック 12.エクセルファイルのA2をコピー 13.CADシステムのファイル名という項目をダブルクリック、その後そこに貼り付け 以上が大まかな流れで、A列の図面番号がなくなるまでの繰り返し作業です。 A列の図面番号の数は毎回バラバラなのでA列の最終行を拾うという条件にする。 毎日かなりの時間を要するので非常に困っています。 どなたかご教示願います。
質問日時: 2024/03/16 23:38 質問者: Wrangleruk
回答受付中
1
0
-
Excelについて
セルには入力規則があり、リストから選択して例えば”検査”等入力ができるのですが、その他で同じセルにリストからの選択ではなく”8”とか数値を入力しようとしてもできないのです。 調べるとできないようなのですが、VBAコードでなんとか入力できるようになるみたいなのですが、私にはコードがかけないです。 教えて頂けないでしょうか。
質問日時: 2024/03/16 20:07 質問者: Chiたん
ベストアンサー
1
0
-
IEを使わないでhtmlテキストを取得したい(VB.Net)
見たいサイトがIEに対応していないため、VB標準のWebbrowserが使えません。FireFoxなど他のブラウザでは見ることができるこのサイトをVB.Netを使って情報取得できるでしょうか。
質問日時: 2024/03/16 14:48 質問者: payphone
解決済
1
0
-
VBAで質問があります
ユーザーフォームで入力して転記はできているのですが 転記時に少々遅い気がするのですがコードに問題ありますでしょうか? Private Sub UserForm_Initialize() Me.TextBox1.Value = Format(Now(), "yyyy/m/d") End Sub Private Sub CommandButton1_Click() Dim I As Long Dim iCheck As Integer Dim r As Range Dim Ctrl As Control Set sht = ActiveSheet Set r = sht.UsedRange Cells(r.Row + r.Rows.Count, r.Column).End(xlDown).End(xlUp).Offset(1, 0).Select For I = 2 To 2000 If Cells(I, 2).Value = "" Then Exit For Next '連番 Cells(I, 1).Value = I - 1 '日付 Cells(I, 2).Value = Me.TextBox1.Value '分類 Cells(I, 3).Value = Me.ComboBox1.Value '品名 Cells(I, 4).Value = Me.ComboBox2.Value '個数 Cells(I, 5).Value = Me.TextBox2.Value '単価 Cells(I, 6).Value = Me.TextBox3.Value '合計 Cells(I, 7).Value = Me.TextBox2 * Me.TextBox3.Value '支払い方法 Cells(I, 8).Value = Me.ComboBox3.Value '備考 Cells(I, 9) = Me.TextBox4.Value Me.TextBox3.Text = "" Me.TextBox4.Text = "" Me.ComboBox2.SetFocus End Sub
質問日時: 2024/03/16 12:18 質問者: maniac
回答受付中
5
0
-
VBAの質問になります 行の非表示
あまり見ない行の非表示設定ができればと思います B列に日付はあります、その日付から2週間以前を自動で(エクセルを開いたら)非表示にしたいです 1行目は項目がありますので表示のままが良いです どこにどのようなコードで動くようになりますでしょうか?
質問日時: 2024/03/16 00:53 質問者: maniac
回答受付中
2
0
-
ExcelVBA シート名を複数セルから取得して変更
VBA超ビギナーです。 シート名をセルから取得して変更するVBAをご教授願えませんでしょうか...。 ①シート名「シート名変更」「日付変更」以外の全てのシートのシート名を変更 ②値はシート「シート名変更」のA2〜A16から取得
質問日時: 2024/03/15 16:08 質問者: kkkkk_99
ベストアンサー
6
0
-
ExcelのVBAコードについて教えてください。
作業ブックの作業シートに Private Sub Worksheet_Change(ByVal Target As Range) を設定しています。 このコードに下記のコードを追加したいのですが、教えてください。 セルC14 C16 C18にせれぞれプルダウンで選択した文字が表示されます 文字は固定文字で「審査」です 3つのセルには必ず1つだけ「審査」が表示されていれば良く 例えばC14に「審査」と表示し 次に16に「審査」を表示させると 最初のC14の「審査」は削除 同じく C18に「審査」を表示させると 次に表示させたC16の「審査」は削除です 例は順番をC14からにしてますが 順番は順不同です 各セルはセルを結合してますので 見た目は縦に3つ並んでます よろしくお願いします。 親切にコードを全て教えてください。 宜しくお願い致します。
質問日時: 2024/03/15 08:31 質問者: エクセル小僧
ベストアンサー
5
0
-
解決済
3
0
-
VBA UserFormからの転記で
画像のように一度にまとめて転記はできるのでしょうか? 参照は管理№の記載列B列になり、その該当した行の18=使用日・ 19=設置または搭載先・20=登録者・21=メモになります 該当する行にそれぞれ転記したいのですが可能でしょうか? 現状このような感じです(中略) 1行だけだと転記できましたが複数になるとダメでした(´;ω;`) '該当管理№があったらを複数作成すればよいのでしょうか? If Cells(iCheck, 2).Value = Me.TextBox2.Text Then If Cells(iCheck, 2).Value = Me.TextBox5.Text Then この場合、Exit SubとEnd Ifを書くコードに追加ですかね? Private Sub CommandButton1_Click() Dim i As Integer Dim iCheck As Integer For i = 2 To 20000 If Cells(i, 2).Value = "" Then Exit For Next '重複チェック iCheck = i For iCheck = 1 To i '該当管理№があったら If Cells(iCheck, 2).Value = Me.TextBox2.Text Then '出荷されてなかったら 'If Cells(iCheck, 23).Value = "" Then '使用日 Cells(iCheck, 18).Value = Me.TextBox1 Cells(iCheck, 18).Value = Me.TextBox1 '使用先/搭載埼 Cells(iCheck, 19).Value = Me.TextBox3 Cells(iCheck, 19).Value = Me.TextBox6 '担当 Cells(iCheck, 20).Value = Me.ComboBox1 Cells(iCheck, 20).Value = Me.ComboBox1 'メモ Cells(iCheck, 21).Value = Me.TextBox4 Cells(iCheck, 21).Value = Me.TextBox7
質問日時: 2024/03/14 14:04 質問者: kacky76
回答受付中
3
0
-
ExcelのVBAコードについて教えてください。
作業ブックのシートに下記のコードを設定しております。 セル「C12」に「審査」と表示されると非表示シート「確認質疑」と「行政回答確認」 が表示出来るようになっております。 この2つのコードを1つのコードにまとめる方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) Sheets("確認質疑").Visible = [C12] = "審査" Sheets("行政回答確認").Visible = [C12] = "審査" End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/03/13 09:23 質問者: エクセル小僧
ベストアンサー
1
0
-
【ExcelVBA】インデックスが有効範囲にありません。の理由が分かりません
下記、VBAソースの一部ですが、やりたい処理は、 本体のマクロブックのSheet1のA2セルにフォルダのパスが、 C2、D2セルにセル位置が記載されています。 そのフォルダ内のすべてのエクセルを順番に開いて指定シートの指定範囲をコピーしたいのです。 各ブックのシート名は異なるのですが、VBAエディタから見たシートの番号はすべて同じなので、シート番号から特定して処理しようと考えました。 開いたブックのSheetIDが28のシートに対して、LeftUp(左上)から右下(RightDown)の範囲をコピーしたいのですが、 「インデックスが有効範囲にありません。」というエラーでストップしてしまいます。 LeftUp = Cells(2, 3).Value ' C2 RightDown = Cells(2, 4).Value ' D2 buf = Dir(Sheets("Sheet1").Range("A2").Value & "*.xlsm") Workbooks.Open Worksheets("Sheet1").Range("A2").Value & "\" & buf, UpdateLinks:=0 Worksheets(28).Range(LeftUp & ":" & RightDown).Copy 原因を教えて頂けると助かります。
質問日時: 2024/03/13 00:34 質問者: tanapyondai
回答受付中
3
1
-
PDF出力マクロについて。マクロ初心者です。 エクセルで、アクティブシートを指定したフォルダに保存す
PDF出力マクロについて。マクロ初心者です。 エクセルで、アクティブシートを指定したフォルダに保存するマクロを組んだのですが、ドライブが違う人でも作動するようにするにはどうしたら良いでしょうか?そもそも不可能なのでしょうか。 コードは以下になります ……………………………………………………………………… Sub アクティブシートPDF出力() Dim strPath As String strPath = "V\○○○○"(指定フォルダのフルパス) Dim ShName As String ShName = ActiveSheet.Name With ActiveSheet.PageSetup Zoom = False FitToPagesWide = 1 FitToPagesTall = 1 End With If MsgBox(ShName &"シートをPDF形式で出力します。よろしいですか?", vbQuestion + vbYesNo) = vbNo Then MsgBox "中止しました。"Exit Sub End If ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=strPath &"\"&ActiveSheet.Range("B8").Text &"_"&Sheets(ShName).Name &".pdf"End Sub ……………………………………………………………………………… また、無駄な部分や追加した方がいいもの等ありましたらアドバイスいただけたらと思います。
質問日時: 2024/03/11 12:44 質問者: chuntarosa__n
ベストアンサー
1
0
-
Excelで「Ctrl+c」、「Ctrl+v」等をまとめた物
Excelで「Ctrl+c,v」はよく使います。同様に「Ctrl+a」等もあればと思います。まとめて発表されておればそのアドレスを教えてください。
質問日時: 2024/03/11 06:23 質問者: aerio
ベストアンサー
5
0
-
VBAコードについて
Sub setData() Dim hitCol As Long Dim i As Long, j As Long Dim errDays() As Long, errCnt As Long '入力データチェック If Not chkData Then End Application.ScreenUpdating = False 'データ登録 With Sheets(strSheet) For i = 1 To 5 If days(i) <> 0 Then Err.Clear hitCol = WorksheetFunction.Match(days(i), .Rows(7), 0) If Err.Number = 0 Then For j = 1 To 27 '組立・行程 .Cells(hitRow + j, hitCol).Value = Cells(j + 9, i * 2 + 2).Value Next j .Cells(hitRow + 30, hitCol).Value = Cells(39, i * 2 + 2).Value '生産数 .Cells(hitRow + 32, hitCol).Value = Cells(40, i * 2 + 2).Value '作業工数 .Cells(hitRow + 33, hitCol).Value = Cells(41, i * 2 + 2).Value 'ケース数 Else errCnt = errCnt + 1 ReDim Preserve errDays(errCnt) errDays(errCnt) = i End If End If Next i End With ThisWorkbook.Save If errCnt = 0 Then Application.ScreenUpdating = True MsgBox "データを[" & strSheet & "]シートにセットしました。", vbInformation Else For i = 1 To errCnt Cells(8, errDays(i) * 2 + 2).Interior.Color = vbYellow Next i Application.ScreenUpdating = True MsgBox "[" & strSheet & "]シートに該当する日が無かったため、データをセットできませんでした。" & vbCrLf & "シートを確認してください。", vbExclamation End If Sheets(strSheet).Activate Application.GoTo Cells(hitRow, "C"), True End Sub のようなコードがあります。 セルC19、C20、D30、D31のデータはセットしないようにしたいのですがどうしてもわかりません。 教えて頂けないでしょうか。お願い致します。
質問日時: 2024/03/10 12:41 質問者: Chiたん
ベストアンサー
2
0
-
解決済
2
0
-
解決済
2
0
-
VBAのコードを教えてください
昨日からVBAを始めた初心者です。 どなたか助けて頂けないでしょうか…。 sheet1からsheet5まであるExcelです。 バージョンは2021 sheet1に集計シートを作っています。 sheet1のC2からC149まで社員番号があり sheet2からsheet5はA2からA41まで それぞれ社員番号があります。 やりたいことは sheet2からsheet5の社員番号が sheet1の社員番号に一致したら sheet2からsheet5のE.F.G.H.I.J列を E.G.I.F.H.J列の順でコピーし sheet1の一致した社員番号のE.F.G.H.I.J列に貼り付けたいです。 更にsheet2からsheet5のD列を sheet1のM列に貼り付けたいです。 sheet1は A1:M149の大きさ sheet2からsheet5は A1:J42の大きさ セルの結合は無しです。 1行目に項目名がある感じで作っています。 文字だけでは伝わりにくいかもしれませんが わかる方、よろしくお願い致します。
質問日時: 2024/03/08 14:15 質問者: いぬ1230
ベストアンサー
5
0
-
以下のコードを実行しても、オブジェクト変数または、withブロック変数が設定されていませんとエラーが
以下のコードを実行しても、オブジェクト変数または、withブロック変数が設定されていませんとエラーが発生します。ネットで解決策を色々と試してみましたが、どうしても実行できません。 VBA初心者です。どなたか、助けて頂けないでしようか? Option Explicit Sub ガントチャート描画() Dim al As Range Dim org As Range Dim dst As Range For Each al In Range("al7:al29") If al.Value <> "" Then Call MyFind(al.Value, org) Call MyFind(al.Offset(0, 3).Value, dst) If al.Offset(0, 7).Value = "H" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(250, 8, 8) .Weight = 3 End With ElseIf al.Offset(0, 7).Value = "A" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(51, 255, 0) .Weight = 3 End With ElseIf al.Offset(0, 7).Value = "K" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(51, 255, 0) .Weight = 3 End With Else: With ActiveSheet.Shapes.AddLine(org.Left + _ 0, al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(0, 0, 128) .Weight = 3 End With End If End If Next End Sub Private Sub MyFind(ByVal src As String, ByRef rng As Range) Dim r As Range Set rng = Nothing For Each r In Range("at5:lu5") If r.Value = src Then Set rng = r Exit Sub End If Next End Sub
質問日時: 2024/03/07 16:21 質問者: かなもゆ
ベストアンサー
1
0
-
【ExcelVBA】VBA実行でダイアログメッセージを無視する方法はありますか?
VBAの処理で、フォルダ内のブックを順番に開きながらコピーしていくといった処理をしてるのですが、 ブックの中には、他のブックを参照する式が入っていた場合、 「更新する」「更新しない」といった問い合わせが表示されてしまい、 いちいちクリックする必要があります。 全て「更新しない」選択を自動化して中断させない方法はありますか?
質問日時: 2024/03/07 11:23 質問者: tanapyondai
解決済
1
0
-
VBAコードについて教えてください、 下記のコードを一つにまとめる方法を教えてください セルF18に
VBAコードについて教えてください、 下記のコードを一つにまとめる方法を教えてください セルF18に "フラット設計審査_標準計算" が表示され 又は セルF18に"フラット設計審査_仕様基準" が表示されると マクロ フラットシート表示が実行出来る方法を教えてください 現状の別々のコードです If Range("$F$18").Value = "フラット設計審査_標準計算" Then Call フラットシート表示 End If If Range("$F$18").Value = "フラット設計審査_仕様基準" Then Call フラットシート表示 End If よろしくお願いします
質問日時: 2024/03/06 20:11 質問者: エクセル小僧
ベストアンサー
2
0
-
ExcelのVBAコードについて教えてください。
先日来より、ここで質問をさせて頂いておりますが、皆様の回答を頂きましたが、 解決に至っておりませんので、改めて質問をさせて頂きます。 作業ブックのシート名「審査」に下記のコードを設定しております。 このブックを使用する手順として、一番産所にセル「F18」をプルダウン選択し、文字を表示させて、作業を進めておりますが、「F18」に「確認申請」を選択するとその後、コードの内、下記のコードが実行できません。 If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Target.Address = "$D$18" Then Call 審査保存1 End If 「F18」に「確認申請」以外を選択するとシートに設定しているすべてのコードが順調に実行できます。 「F18」に「確認申請」を選択すると If Range("$F$18").Value = "確認申請" Then Call 確認シートコピー End If が実行されますが、このコードに問題があるのでしょうか。 マクロ「確認シートコピー」は Sub 確認シートコピー() Call 確認用シート表示 Dim i As Integer i = 1 Do While i > 0 i = i + 1 If i > 1 Then Exit Do End If Debug.Print i Loop Sheets("確認申請シート").Select Range("B1:I52").Select Selection.Copy Sheets("質疑").Select Range("B1:I52").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=0 Sheets("確認申請シート").Select ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 20 Range("AC24:AC52").Select Selection.Copy Sheets("質疑").Select ActiveWindow.SmallScroll ToRight:=21 Range("AC24:AC52").Select ActiveSheet.Paste ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 1 Call 確認用シート非表示 Call F行調整 Range("F15").Select End Sub です。 シート名「審査」の全体のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Range("$F$18").Value = "フラット設計審査_標準計算" Then Call フラットシート表示 End If If Range("$F$18").Value = "フラット設計審査_仕様基準" Then Call フラットシート表示 End If If Target.Address = "$F$18" Then Call 担当者メッセージ End If If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Range("$F$18").Value = "確認申請" Then Call 確認申請関係シート表示 End If If Range("$F$18").Value = "確認申請" Then Call 確認シートコピー End If If Range("$F$18").Value = "確認申請" Then Call 電子行政選択表示 End If If Range("$F$18").Value = "確認申請" Then Call 行政メッセージ End If If Target.Address = "$D$18" Then Call 審査保存1 End If End Sub 以上となります。 「F18」に「確認審査」を表示させても全てのコードが上手く行くように解決できる方法を教えてください。宜しくお願い致します。
質問日時: 2024/03/06 13:07 質問者: エクセル小僧
ベストアンサー
1
0
-
ExcelのVBAコードについて教えてください。
作業ブックのシートに下記のコードを設定しております。 If Target.Address = "$F$15" Then Call 担当者情報総合 End If このコードは、セルF15に不特定の文字が表示されるとマクロ「担当者情報総合」が実行されますが、 このコードに「指定シート名」を追加できる方法を教えてください。 指定シート名は「質疑」としてください。 同じく If Range("$F$18").Value = "確認申請" Then Call 確認申請関係シート表示 End If このコードは、セルF18に「確認申請」と文字が表示されるとマクロ「確認申請関係シート表示」が実行されますが、 このコードに「指定シート名」を追加できる方法を教えてください。 指定シート名は「質疑」としてください。 以上となります。 宜しくお願い致します。
質問日時: 2024/03/05 09:03 質問者: エクセル小僧
ベストアンサー
4
1
-
エクセルVBAの配列について
VBA初心者です。 ワークシートのリストを配列に取り込むに当たって 特定の列を一挙に取り込むにはどうすれは良いでしょうか。 Array_data(,3)=range(cells(1,7),range(cells(rows.count,7).end(xlup).row,7) とか Array_data.columns(3)=range(cells(1,7),range(cells(rows.count,7).end(xlup).row,7) を試してみたのですがうまくいきません。 よろしくお願いします。
質問日時: 2024/03/04 16:21 質問者: eHiro401
解決済
1
0
-
エクセルvbaについて
tatsumaru77様 以前投稿した内容で転記の追加をしたいのですが、内容は別ファイルへの転記をB列の1行目から添付の内容をお願いします。A列の転記内容はそのままでいいです。 AA0000Z00001* B列にはS列とU列の転記はなしです。 それとこのコードだと転記した後に、もう一度転記処理を行うと最初に転記したものが消えてしまいます。一度転記したものは消さずにその下から転記されるようにしたいです。A列B列も同じようにです。 自分で変更してみましたが、うまくいきません。 申し訳ありませんが、よろしくお願いいたします。 Public Sub 別ファイルへ転記() Dim fpath As String Dim wb As Workbook Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow1 As Long Dim row1 As Long Dim row2 As Long Set ws1 = ActiveSheet fpath = "C:\Users\t-tai\OneDrive\デスクトップ\図番\図番転記.xlsx" Set wb2 = Nothing For Each wb In Workbooks If wb.Name = "図番転記.xlsx" Then Set wb2 = wb Exit For End If Next If wb2 Is Nothing Then Set wb2 = Workbooks.Open(fpath) End If Set ws2 = wb2.Worksheets(1) ws2.Cells.ClearContents row2 = 1 maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row For row1 = 13 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value & "*" row2 = row2 + 1 End If Next or row1 = 13 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & "*" row2 = row2 + 1 End If Next End Sub
質問日時: 2024/03/02 01:11 質問者: Wrangleruk
ベストアンサー
6
0
-
エクセルのマクロについて教えてください。
シート名「審査」に下記のコードを設定しておりますが、 下記のコードが上手く実行されない原因の解決方法を教えてください。 下記のコードは指定セル値の変更により指定マクロが実行されますが、 例えば 一番最初に セルF15を変更すると上手く指定マクロが実行されます、その後、セルF18を変更した場合は、指定マクロが実行されません、同じくセルD18を変更した場合もマクロが実行されません。 違うパターンで 最初にF18を変更するとマクロが実行され、その後、F15や D18を変更してもマクロが実行できません。 もう一つ違うパターンで 最初にD18を変更するとマクロが実行され、 その後、F15やF18を変更するとマクロが実行されません。 結論として、F15・F18・D18のどれか一つを変更した後は、残りのセルを変更してもマクロが実行されないのです。 解決方法を教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Target.Address = "$F$18" Then Call 担当者メッセージ End If If Target.Address = "$D$18" Then Call 審査保存1 End If End Sub 上記のコードは指定セル値に不特定の文字が表示された時に指定マクロが実行出来るようにしてますが、上手く実行できません。 その他のコードは上手く実行できます。 原因は上手く実行されないコードは不特定の文字の表示 上手く実行できるコードは特定の文字の表示にあるのでしょうか? 宜しくお願い致します。 以上となります。 宜しくお願い致します。 Visual Basic | Excel・163閲覧・25
質問日時: 2024/03/01 17:04 質問者: エクセル小僧
ベストアンサー
2
0
-
Excel関数またはVBAでの質問になります
セル内の文章内で"[説明]"を先頭に空白までを抜粋して別のセルに表示できませんか? LEFT・MID・RIGHT・FIND関数は試しました =MID(B2,FIND("[説明]",B2),60) =LEFT(B2,60) 表示させる文字数が各セルでまちまちなので指定ができません 指定してしまうと他の項目まで表示してしまうためできれば説明文のみが希望です なので最後の空白または次の[]手前までで〆れば 説明文章のみ表示できるかなと思ったのですが(;^_^A ちなみに関数では表示のみですがVBAでは転記できるのでしょうか? B列に貼り付けたらC列に[説明]から空白までまたは次の[]手前までが転記出来たらありがたいです
質問日時: 2024/02/29 16:06 質問者: kacky76
解決済
5
1
-
VBA 複数の各シートに行を追加したいです
お世話になっております。 複数の各シートに行を追加したいです。 コードを考えてみました。 以下のコードで相違ないでしょうか。 Sub Test2() Dim Wb1 As Workbook, Wb2 As Workbook Dim Ws1 As Worksheet, Ws2 As Worksheet Dim LastRow1 As Long, LastRow2 As Long Dim sheetNames As Variant Dim i As Integer ' ソースのWorkbookを定義 Set Wb1 = Workbooks("Book1.xlsm") ' ターゲットのWorkbookを定義 Set Wb2 = Workbooks("Book2.xlsm") ' シート名の配列を定義 sheetNames = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", "Sheet13", "Sheet14") ' 各シートにループ For i = LBound(sheetNames) To UBound(sheetNames) ' ソースのWorksheetを定義 Set Ws1 = Wb1.Sheets(sheetNames(i)) ' ターゲットのWorksheetを定義 Set Ws2 = Wb2.Sheets(sheetNames(i)) ' 最終行を見つける LastRow1 = Ws1.Cells(Ws1.Rows.Count, "C").End(xlUp).Row LastRow2 = Ws2.Cells(Ws2.Rows.Count, "C").End(xlUp).Row ' コピーと挿入 Ws1.Rows("2:" & LastRow1).Copy Ws2.Rows(LastRow2 + 1).Insert Shift:=xlDown ' クリップボードをクリア Application.CutCopyMode = False ' オブジェクト参照を解放 Set Ws1 = Nothing Set Ws2 = Nothing Next i ' オブジェクト参照を解放 Set Wb1 = Nothing Set Wb2 = Nothing End Sub ご回答をお待ちしております。 どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/28 22:09 質問者: yuri_7
解決済
2
0
-
VBA 別ブックからコピペしたいのですが、軽くしたいです
VBAかなり初心者です。 シンプルなVBAのフォーマットを作成してみましたが、とっても遅いです。 色々調べたものの、自分でやりたいことが軽いコードでできませんでした…。 1.別のブックは毎回ブックネームが異なるため、ファイルから選択する形式を希望 (今回はREPORT.xlsxのFinal Dataシートより) 2.そのブックの列ごとコピーして、このVBAが入っているブック(Book1.xlsm)のDataシートに貼付けをしたい ************************************************************************* Sub Sample2() '別ブックを開く Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If 'データをコピー 上記で選択して開いた別ブック Windows("REPORT.xlsx").Activate a = Sheets("FinalData").Select Columns("A:A").Select Application.CutCopyMode = False Selection.Copy 'データをペースト Windows("Book1.xlsm").Activate Sheets("Data").Select Columns("A:A").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove End Sub ************************************************************************ いくつか速くできるようなQ&AのWEBページがあったのですが、なかなかうまく回りませんでした…。 コードを教えていただけると大変助かります。 何卒よろしくお願いいたします。
質問日時: 2024/02/26 18:41 質問者: Sakokosan
解決済
3
0
-
VBA 別ブックから条件に合うものを転記したいです
上の表を埋めるため、別ブックの下の表から条件に合うセルを転記し、また、空白のセルに[x]を入れたいです。 東京-りんご セルB2に入るのはa(B4) セルC2、D2はx VBA初心者の為、なかなか上手く行かず、、、 ご教授よろしくお願いします。
質問日時: 2024/02/25 21:39 質問者: moff12010816
ベストアンサー
3
0
-
配列のペースト出力結果の書式について
配列のペースト出力結果の書式について、どうも書式が反映されなくて困っております。 dim AllmydataArr as Variant dim SourceRng as range, TargetRng as range wbとmbは それぞれのBookのパス先です Set SourceRng = Wb.Worksheets("sheet5").UsedRange AllmydataArr = SourceRng Set TargetRng = mb.Worksheets("sheet1").Range("A1") TargetRng.Resize(UBound(AllmydataArr, 1), UBound(AllmydataArr, 2)) = AllmydataArr と現在このようにResizeとUBoundをつかって配列AllmydataArrのペースト出力結果を出しております。 このままでは値貼り付けで終わってしまい、書式の移動ができておりません。 NumberFormat を使おうにもエラーがでてしまいます。 どのようにVBAを表現すると元のSheetにある書式が反映されるようになるのでしょうか。 教えていただけると幸いです。よろしくお願いいたします
質問日時: 2024/02/25 14:50 質問者: ひかりりあ
ベストアンサー
3
0
-
for 文の 繰り返し処理に使えるのかどうかについて
ExcelのVBA について質問があります。 1つのブックの4つのシートに対して4回違うブックのシートからコピぺを繰り返そうと思っております。 Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook Dim FullPath1 As String, FullPath2 As String, FullPath3 As String, FullPath4 As String Dim SourceRng1 As Range, SourceRng2 As Range, SourceRng3 As Range, SourceRng4 As Range Dim TargetRng1 As Range, TargetRng2 As Range, TargetRng3 As Range, TargetRng4 As Range Worksheets("kyu").Cells.Clear Worksheets("nyu").Cells.Clear Worksheets("gai").Cells.Clear Worksheets("sesho").Cells.Clear と、dimでの設定が4種類が4回、元のシートのクリアが4回なので、悩んだ挙句 Dim i As Integer For i = 1 To 4 SourceRng(i).Copy TargetRng(i).PasteSpecial Paste:=xlPasteColumnWidths TargetRng(i).PasteSpecial Paste:=xlPasteValues TargetRng(i).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False i = i + 1 Next としました。 .PasteSpecial Paste:=pasteall ではないのは、行うと図にされて貼り付け先に貼り付けされてしまうからです。 結局のところ、Dimで指定した数字は(i)としてfor文で可能なのか Worksheetsは.Cells.Clearでまとめて表現できるのか .PasteSpecial Paste も短く表現できないか 浅学なので、全く解決策が見いだせません。現在は1から4まで直線的にコピペをVBAで行っております。 簡略化できると嬉しいです。 まずは可能かどうか、そして解決方法を教えていただけると嬉しいです よろしくお願いいたします。
質問日時: 2024/02/25 09:52 質問者: ひかりりあ
ベストアンサー
10
1
-
Excelで画像URLを1つずつセルに振り分けたい
ExcelのA1に下記のような画像URLが複数あり、改行された状態で保存されています。 B1,B2,B3,B4,B5に、画像URLを1つずつセルに振り分けたいです。 下記のようにB1に関数を入れ、B1はうまくいきましたが、 B2,B3,B4,B5に繰り返しが出来ていません。 =FILTERXML("<t><s>" & SUBSTITUTE(A1, CHAR(10), "</s><s>") & "</s></t>", "//s") どのように書き替えれば良いでしょうか? よろしくお願いいたします。 https://yahoo.co.jp/images/I/51zE4g7B3XS._AC_.jpg https://yahoo.co.jp/images/I/51mw3kiGQHL._AC_.jpg https://yahoo.co.jp/images/I/518nTESXpUL._AC_.jpg https://yahoo.co.jp/images/I/51s7tENUsoL._AC_.jpg https://yahoo.co.jp/images/I/51Ka9evm3CL._AC_.jpg https://yahoo.co.jp/images/I/51GPh29MXzL._AC_.jpg https://yahoo.co.jp/images/I/51r0QUBwEVL._AC_.jpg"
質問日時: 2024/02/24 01:59 質問者: tutuu
ベストアンサー
2
0
-
Excel VBA 文字列のセルを反映させたいです
大変お世話になっております。 以下のVBAを実行すると、セルの書式設定で『文字列』のセル(例えば、052等、数字の頭が0のため文字列にしたセル)が反映されません…。 (複数のシートを1つのシートにまとめるVBAでして、まとめる前の元のシートに文字列が含まれています) 文字列を反映したいため、コードの修正をしていただけると有難い限りです…。 お手数ですが、コードの全文をご記載いただけると本当に助かります…。 Sub 複数のシートを1つのシートにまとめる() Dim i As Long Dim r As Long Dim s As Long Dim Sh As Worksheet Dim MaxRow As Long Dim MaxCol As Long Dim MyArray As Variant Dim JoinSh As Worksheet Application.DisplayAlerts = False 'シート削除時のアラート停止 For Each Sh In Worksheets If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除 Next Application.DisplayAlerts = True 'シート削除時のアラート停止を解除 s = 1 '最大行を超えた場合次の統合シートを作成するための番号 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" Set JoinSh = ActiveSheet '統合シートを変数に格納 For i = s + 1 To Worksheets.Count 'シートを統合シートの次~末尾までループ With Worksheets(i) '各月シート If i = 2 Then r = 1 '最初だけ項目も取得 Else r = 2 '最初以外は2行目から取得 End If MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得 MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)) 'A1~データ末尾まで配列に格納 End With With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理 s = s + 1 '統合シートの番号を加算 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加 Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If If .Cells(1, 1) = "" Then '最初だけ1行目から貼り付け Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray Else '最初以外は最終行の次に貼り付け Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray End If End With Next i End Sub ご回答を心よりお待ちしております。 大変恐縮ですが、どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/24 00:06 質問者: yuri_7
ベストアンサー
2
0
-
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデー
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデータが入っています。AD10行目のフィルターからワイルドカードを使用して※2113※、※20F※、※20C07※以外をVBAを使用して表示させる方法は、ありますでしょうか?宜しくお願い致します。
質問日時: 2024/02/21 16:09 質問者: ほいほい侍
解決済
4
0
-
Excel VBA マクロ あるフォルダー内の複数のファイルを統合したいです
大変お世話になっております。 ●あるフォルダー内の複数のファイルを1つのファイル統合したいです。 1)複数のファイルのファイル名は異なります。 2)複数のファイルの各々のシート名は同一です。 3)複数ファイルの形式は同一です。 4)一つに統合した際に、シート名・形式を保ったままにしたいです。 現在は… フォルダー内のファイルを一度各シートにし、その後、統合するVBAを使用しています。 統合した際に形式が保てませんし、2度手間になっています…。 ■1■まず…以下を行い Sub フォルダー内のファイルを各シートへまとめる() Dim Filename As String Dim IsBookOpen As Boolean Dim OpenBook As Workbook Dim ShCount As Long With CreateObject("WScript.Shell") .CurrentDirectory = "F:\2024.02.19_複数ファイルを一つにまとめる\新しいフォルダー" 'ここで読み込むフォルダを直接指定するF:\2022.12.01_複数ファイルを一つにまとめる End With Filename = Dir("*.xlsx") Do While Filename <> "" If Filename <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenBook In Workbooks If OpenBook.Name = Filename Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then ShCount = ThisWorkbook.Worksheets.Count Workbooks.Open (Filename), UpdateLinks:=1 Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount) Workbooks(Filename).Close savechanges:=False End If End If Filename = Dir() Loop End Sub ■2■次に以下を行い… Sub 複数のシートを1つのシートにまとめる() Dim i As Long Dim R As Long Dim s As Long Dim Sh As Worksheet Dim MaxRow As Long Dim MaxCol As Long Dim MyArray As Variant Dim JoinSh As Worksheet Application.DisplayAlerts = False 'シート削除時のアラート停止 For Each Sh In Worksheets If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除 Next Application.DisplayAlerts = True 'シート削除時のアラート停止を解除 s = 1 '最大行を超えた場合次の統合シートを作成するための番号 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" Set JoinSh = ActiveSheet '統合シートを変数に格納 For i = s + 1 To Worksheets.Count 'シートを統合シートの次~末尾までループ With Worksheets(i) '各月シート If i = 2 Then R = 1 '最初だけ項目も取得 Else R = 2 '最初以外は2行目から取得 End If MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得 MyArray = Range(.Cells(R, 1), .Cells(MaxRow, MaxCol)) 'A1~データ末尾まで配列に格納 End With With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理 s = s + 1 '統合シートの番号を加算 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加 Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If If .Cells(1, 1) = "" Then '最初だけ1行目から貼り付け Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray Else '最初以外は最終行の次に貼り付け Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray End If End With Next i End Sub ■3■最後に…、手作業で形式をコピーし、統合したファイルにペーストしています。 一度で解決するVBAをお教えいただけると本当に有難い限りです…。 お手数ですが、ご回答を心よりお待ちしております。 大変恐縮ですが、どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/19 21:37 質問者: yuri_7
ベストアンサー
1
0
-
VBA ファイル名取得
ネットで調べて下記のVBAでファイル名が取得できるみたいなんですができません。何か間違っているところありますか?いろいろ調べて他のコードも試したのですができません。そもそもガイル名を取得するさいになにか特殊な設定等ありますか? Sub GetFileName() Dim FileName As String Dim Path As String Dim i As Long ' このファイルがあるフォルダーのパスを取得 Path = ThisWorkbook.Path ' フォルダ内のエクセルファイル名を取得して貼り付ける FileName = Dir(Panh & "\ファイル\" & "*.xlsx") 'ファイル名を各行の初期値を設定 i = 2 '該当するファイルがなくなるまでループ Do While FileName <> "" 'ファイル名をセルに入力 Cells(i, 1) = FileName '次のファイルを取得 FileName = Dir() 'iをカウントアップ i = i + 1 Loop End Sub
質問日時: 2024/02/18 13:24 質問者: ケイ0000
解決済
3
0
-
メールの件名をデコードしたい
メールをダウンロードしてテキストで見ると、 件名は、例えばこのように表示されます。 Subject: =?ISO-2022-JP?B?GyRCJCpPTSRTJEgkNE8iTW0bKEI=?= これをデコードすると、Subject:お詫びとご連絡 になります。(WEBに変換サイトあり) この作業をVBAでできないでしょうか?
質問日時: 2024/02/17 10:53 質問者: Ninjya2436
ベストアンサー
1
0
-
メールの件名のセットでエラーになる原因がわかりません
メールの件名をデコードしようとしていますが、 こんな簡単な操作にエラーがでてしまいます。 If Left(LineDATA1, 8) = "Subject:" Then SBJvalue1 = Mid(LineDATA1, 10, 100) End If Cells(rawi, 4) = SBJvalue1 ← ここで、以下のエラーで止まります。 実行時エラー1004 アプリケーションの定義エラーまたはオブジェクトの定義エラー 何が原因でしょうか?
質問日時: 2024/02/17 09:20 質問者: Ninjya2436
ベストアンサー
2
0
-
エクセルファイルのデータ転記について
画像の下のエクセルファイル(CSVと記載がありますがエクセルです)のデータを上の転記ファイルに転記させるマクロを作りました。赤の矢印のところに転記させるようにしています。 転記ファイルの黄色部の図番、品名、内製価格のデータは下のエクセルファイルにはありません。 この3つは現在、前回のデータをコピペしています。 例えば上の転記ファイルは下のエクセルファイルのデータを転記させた状態で、この時点では黄色部の部分は空白の状態です。 転記ファイルのC列のオ-ダ-NO. AA0000 D列のB00 E列の080 F列の枝番04-00 画像にはありませんが、もっと上のほうに枝番03-00という1個前のデータがあるので、03-00の時のデータをコピーして貼り付けをしています。この作業がなかなか大変なのでこちらも前のデータのものを拾って転記できないかと考えています。 考えているのが、AA0000 B00 080という番号を図番のAA0000B000801Bとマッチさせて転記できないかと。 画像のファイルだと次にAA0000 B00 080がきた場合枝番は06-00となりますが、図番、品名、内製価格の3つは前回の枝番のものと同じにしたいのです。 ややこしいのですが、枝番は数字だけではなくアルファベットの時もあります。AD-00など。その場合前回の枝番はAC-00。このように下へとどんどんデータが追加されていきます。 どういうやり方がよいのかは分かりませんが、自分で考えてみたコードだとうまくいきません。コードを貼り付けるので、いい方法があれば教えて頂きたいです。 図番、品名、内製価格のところのコードです。 分かりやすいように少し間隔を開けています。 ちなみに図番、品名、内製価格以外の転記はできています。 Sub 転記() Dim wb As Workbook Dim sh As Worksheet Dim fname As String Dim tbl As Variant Dim r1 As Long, r2 As Long Dim i As Long Application.ScreenUpdating = False Set sh = ActiveSheet With sh r1 = .Cells(Rows.Count, 2).End(xlUp).Row tbl = .Range("C3:K" & r1) End With fname = ThisWorkbook.Path & "\" & "注文.xlsx" Set wb = Workbooks.Open(fname) With wb.Worksheets(1) For r2 = 27 To .Cells(Rows.Count, 1).End(xlUp).Row r1 = r1 + 1 sh.Cells(r1, 2).Value = .Cells(r2, 8).Value '注番転記 sh.Cells(r1, 3).Value = .Cells(r2, 9).Value 'オ-ダ-NO.転記 sh.Cells(r1, 4).Value = .Cells(r2, 10).Value '部門転記 sh.Range(sh.Cells(r1, 5), sh.Cells(r1, 6)).NumberFormatLocal = "@" sh.Cells(r1, 5).Value = Format(.Cells(r2, 11).Value, "000") '製番転記 sh.Cells(r1, 6).Value = Format(.Cells(r2, 12).Value, "00") & "-" & Format(.Cells(r2, 13).Value, "00") '枝番転記 sh.Cells(r1, 9).Value = .Cells(r2, 17).Value '数量転記 sh.Range(sh.Cells(r1, 10), sh.Cells(r1, 11)).NumberFormatLocal = "#,##0" sh.Cells(r1, 10).Value = .Cells(r2, 16).Value '単価転記 sh.Cells(r1, 17).Value = .Cells(r2, 7).Value '発注日転記 sh.Cells(r1, 18).Value = .Cells(r2, 20).Value '納期転記 '図番,品名,内製価格 For i = 1 To UBound(tbl) If .Cells(r2, 9).Value = tbl(i, 1) And .Cells(r2, 10).Value = tbl(i, 2) _ And .Cells(r2, 11).Value = tbl(i, 3) Then sh.Cells(r1, 7).Value = tbl(i, 5) sh.Cells(r1, 8).Value = tbl(i, 6) sh.Cells(r1, 11).Value = tbl(i, 9) Exit For End If Next i 'メーカー Select Case .Cells(r2, 5).Value Case "CHUAN YAO MACHINERY CO.,LTD" sh.Cells(r1, 16).Value = "全曜機械" Case "ZEN MACHINERY CO.,LTD" sh.Cells(r1, 16).Value = "大成ハイテック" Case "MANUFACTURING(THAILAND)" sh.Cells(r1, 16).Value = "HMT" End Select Next r2 End With With sh End With Range("A1:A2000").EntireRow.Delete wb.Save wb.Close 'wb.Close 'Kill fname Application.ScreenUpdating = True End Sub どなたか知恵えを貸して下さい。 よろしくお願いします。
質問日時: 2024/02/17 02:10 質問者: Wrangleruk
ベストアンサー
2
0
-
VBA エクセルで1列で表示したい。
このマクロなんですが、Sent_88310.emlを1列で表示したいのですが、ここにあるように myFields = Split(inRec, ",") カンマで区切られて、2列になってしまいます1列にしたく、 いろいろ、やってみますが、構文エラーになったり、うまく動きません。 どんなふうに、修正したらいいのでしょうか? --------------------- Public Sub ReadCSV() 'CSVファイルの読み込み Dim n As Long Dim myFields As Variant Dim inRec As String Dim r As Long Dim c As Long n = FreeFile Open ThisWorkbook.Path & "\Sent_88310.eml" For Input As #n r = 1 Do While Not EOF(n) Line Input #n, inRec myFields = Split(inRec, ",") For c = 0 To UBound(myFields) Cells(r, c + 1).Value = myFields(c) Next c r = r + 1 Loop Close #n End Sub ---------------------------
質問日時: 2024/02/16 20:34 質問者: Ninjya2436
ベストアンサー
1
0
-
VBAで特定のシート以外のシート名を変更したい
VBA超ビギナーです。 ネットで調べて、「すべてのシート名を日付に変更する」まではできたのですが、「特定のシート(シート名「シート名変更」)を除外してシート名を変更する」にするにはどこをどう変更すればいいのかわかりません。 以下は現在組んでいるコードです。 どのように変更すればよいでしょうか? Sub シート名一括で変える() Dim Ws As Worksheet Dim D As Date '最初の日付 D = Range("D3").Value '全シートをループ For Each Ws In Worksheets 'シート名を変更する Ws.Name = Format(D, "m.d(aaa)") '日数にプラス1をする D = D + 1 Next Ws End Sub
質問日時: 2024/02/14 13:00 質問者: kkkkk_99
ベストアンサー
2
0
-
Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したい
Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したいのですが、下記のコードですと、古い受信日時から1件しか取得できません。 出来れば、「受信トレイ」や「移動」「下書」きなどの取得したいフォルダーを選択し、新しい日付けから、「受信日時」「件名」「本文」を一括で Excelに転記できるVBAコードに設定にして頂けると助かります。 よろしくお願いいたします。 VBAコードURL https://writening.net/page?NWK5ZZ
質問日時: 2024/02/11 00:46 質問者: ボアヒロ
ベストアンサー
1
1
-
マクロについて質問です。 セルの内容をクリアするコマンドボタン(AX) を作成しました。 指定範囲が
マクロについて質問です。 セルの内容をクリアするコマンドボタン(AX) を作成しました。 指定範囲が30個までなので、 ボタンが全部で4つあります。 これを1つにまとめて1度にすべてクリアしたいです。 やり方を教えてください。 お願いします。
質問日時: 2024/02/10 19:13 質問者: せえちゃん
解決済
1
0
-
Excel VBAで値を変えながら、pdf出力したい
いつもありがとうございますm(__)m 学生の成績個票をVBAを用いて、印刷しています。(以下のコードです) Sub 正方形長方形1_Click() a = Range("M2") b = Range("O2") For i = a To b Range("B2") = i Worksheets("印刷用1").PrintOut Next i End Sub ------------------------------------------------------------------------- 今度は、学生番号〇番~〇番の成績個票を、pdf出力したいのですが、どのようなコードをかけばいいのでしょうか? ちなみに、ひとつのファイルに出力したいです。 お詳しい方、宜しくお願い致します。
質問日時: 2024/02/10 10:46 質問者: mapmap1027
ベストアンサー
3
0
-
wordの文書内で上から順番に"有"、"無"などを走査し該当のキーワードがあったら丸で囲む、最終文字
wordの文書内で上から順番に"有"、"無"などを走査し該当のキーワードがあったら丸で囲む、最終文字列まで上から順番にメッセージボックスに任意のキーワードを入れ、既に丸がある所はスキップみたいなことをしたく下記のような形で組んでみたのですが、エラーとなり思ったように処理ができません。 コンパイルエラー箇所 Set rng = rng.Find(keyWord, After:=rng.End, LookAt:=wdWhole) 検索などしてみましたが、よく理解できるページも見つけられずです。 参考になるサイトやここが悪いというような助言をいただけます幸いです。 元のソース Sub AddCircleHighlight() Dim doc As Document Dim rng As Range Dim keyWord As Variant Dim shp As Shape Set doc = ActiveDocument ' "有"と"無"のリスト keyWord = Array("有", "無") For Each keyword In keyWord For Each rng In doc.StoryRanges Do Set rng = rng.Find(keyword, LookAt:=wdWhole) If Not rng Is Nothing Then ' 既に〇が付いている場合はスキップ If InStr(rng.Text, "〇" & keyword & "〇") = 0 Then Set shp = doc.Shapes.AddShape(msoShapeOval, rng.Information(wdHorizontalPositionRelativeToPage), _ rng.Information(wdVerticalPositionRelativeToPage), 15, 15) With shp .Fill.Visible = msoFalse .Line.Weight = 1 .Line.ForeColor.RGB = vbBlack End With rng.Collapse wdCollapseEnd End If Else Exit Do End If Loop Next rng Next keyword End Sub
質問日時: 2024/02/08 16:41 質問者: HS83als
解決済
1
0
-
Excel VBA マクロ シート名を変えずにA列にあるセル名の名前でファイルの分割をしたいです
大変お世話になっております。 以下のVBAですと、シート名がA列に入力されている文字と同様になってしまいます。 分割する元ファイルのシート名をそのまま残し、A列に入力されている文字にてファイルの名前を付け分割をしたいです。お手数ですが、修正をお願い申し上げます。 ご回答をお待ちしております。 どうぞ宜しくお願い申し上げます。 Sub MAIN() Dim TName, TX As Long With ThisWorkbook Set ws1 = .Sheets(1) .Sheets.Add after:=ws1 Set ws2 = ActiveSheet End With With ws1 .UsedRange.Columns("A").Copy ws2.Range("A1") End With ws2.Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes '担当名を配列に格納 TName = Application.Intersect(ws2.UsedRange, ws2.UsedRange.Offset(1)).Value Application.DisplayAlerts = False ws2.Delete Set ws2 = Nothing Application.ScreenUpdating = False For TX = LBound(TName) To UBound(TName) Call SheetSPLIT(TName:=TName(TX, 1)) Next End Sub Private Sub SheetSPLIT(ByVal TName As String) Dim Wb2 As Workbook Dim ws2 As Worksheet, RX As Long 'Sheet1を複写→新しいブック ws1.Copy Set Wb2 = ActiveWorkbook Set ws2 = Wb2.Sheets(1) With ws2 .Name = TName If .AutoFilterMode Then .Range("A1").AutoFilter For RX = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 If .Cells(RX, "A").Value <> TName Then .Rows(RX).Delete End If Next .Range("A1").AutoFilter field:=1 End With Wb2.SaveAs Filename:=ThisWorkbook.Path & "\" & TName & ".xlsX" Wb2.Close Set Wb2 = Nothing End Sub
質問日時: 2024/02/05 22:10 質問者: yuri_7
ベストアンサー
3
0
-
outlookの受信日時、本文などをExcelに転記したいのですが・・・
初期設定で、 VBAのツール→参照設定VBAProject→「Runtimescript Library」のライブラリにチェックがないのですが、Windows10 64ビット、 Excelのバージョンは、2010年なのですが、「Runtimescript Library」の参照項目はないのでしょうか? Microsoft Outlook 16.0 Object Libraryは、項目があり、チェックを入れられます。 どうぞよろしくお願い致します。
質問日時: 2024/02/05 20:35 質問者: ボアヒロ
ベストアンサー
2
0
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
税理士に聞いてみた「定額減税ってなんですか?対象者は?注意事項は?」
物価高騰の煽りを受ける中、「税が減る」と聞けば手放しに喜んでしまう。では「定額減税」にも同様の感想を持つだろうか。減税という文字が入っているため、税が減ることは間違いなさそうではあるが、少しとっつきづ...
-
メダロット:第233話「Vol.233※期間限定公開」
天才メダロッター六葉カガミの戦いを描く「メダロット再~リローデッド~」(漫画:伯林、監修:イマジニア)、20周年を迎えた『メダロット』が新たなストリーでココに再起動!!★全話無料で読める、週刊メダロット通信...
-
北欧風のお部屋にしたい!賃貸住宅でも可能な北欧スタイルの部屋作りのポイントを紹介
快適なおうち時間を過ごすため、自宅を自分好みのインテリアにしたいと思ったことはないだろうか。新生活を前に、新居の想像を膨らませている人もいるかもしれない。しかし、せっかく家具や壁紙をそろえても、“どう...
-
メダロット:第232話「Vol.232※期間限定公開」
天才メダロッター六葉カガミの戦いを描く「メダロット再~リローデッド~」(漫画:伯林、監修:イマジニア)、20周年を迎えた『メダロット』が新たなストリーでココに再起動!!★全話無料で読める、週刊メダロット通信...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
急にEXCELのVBAで写真の貼り付けが...
-
ExcelのVBAです。フォルダ内の全フ...
-
CADシステムに図面番号を入力してド...
-
VBAで質問があります
-
ExcelのVBAコードについて教えてく...
-
Excelについて
-
VBA UserFormからの転記で
-
IEを使わないでhtmlテキストを取得...
-
【ExcelVBA】インデックスが有効範...
-
ExcelのVBAコードについて教えてく...
-
VBAの質問になります 行の非表示
-
ExcelVBA シート名を複数セルから取...
-
ExcelのVBAコードについて教えてく...
-
VBAコードについて
-
Excel VBA マクロ あるフォルダー内...
-
【VBA】マクロの入ったファイルと同...
-
ユーザーフォームに別シートからデ...
-
VB.netのADOってなんですか?
-
PDF出力マクロについて。マクロ初心...
-
Excel VBA 文字列のセルを反映させ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel VBA マクロ シート名を変えず...
-
VBA
-
VBA 指定した回数分、別シートにコピー
-
Outlookの「受信日時」「送信者アド...
-
Excelのマクロ(VBA)は、同じソー...
-
郵便番号検索APIにてget ElementByT...
-
outlookの受信日時、本文などをExce...
-
【マクロ】プルダウンが設定してあ...
-
引数に数値、文字列の混在
-
VBA実行後に元のセルに戻りたい
-
エクセルVBAでデータ転記
-
近似した文字列を置換するエクセル...
-
for 文の 繰り返し処理に使えるのか...
-
ユーザーフォームに別シートからデ...
-
Excel VBAで値を変えながら、pdf出...
-
Outlookにて既にウィドウ単体で開い...
-
【VBA】マクロの入ったファイルと同...
-
メールの件名をデコードしたい
-
Outlookの「受信日時」「件名」「本...
-
VBA 何かしら文字が入っていたら
おすすめ情報