Visual Basic

全22206件中1~10件表示
  • VBAでのORの使い方

    以下のようなVBAがあります。指定したフォルダーに保存されているエクセルのファイル名を取得するものです。 ここでやりたいのは、AとJPから始まるファイルを取得したいのですがうまくいきません。これですのコンパイルエラーが出ます。 どう変更すべきかご教示願います。 Sub ファイル名取得() Const SEARCH_DIR As String = "\\SOGKF01.JP.TakataCorp.com\XXXXXXXX\YYYYY" Const SEARCH_FILE As String = "AS*.xlsm" Or Const SEARCH_FILE As String = "JP*.xlsm" Dim tmpFile As String Dim strCmd As String Dim buf() As Byte Dim FileList() As String Dim myArray() As String Dim cnt As Long, pt As Long, i As Long 続く

  • VBA セル内改行+他セルの文字をカット&ペースト

    A1セル内文字の最後部分にカーソルを持っていって、Alt+Enterを押してA1セルを2行に改行する、 B1にある値をカットして、A1の改行した部分に貼り付け というマクロを作るべく、「マクロの記録」をしてみたところ、A1のテキストがそのままマクロに書き込まれてしまって応用ができないです。 改行部分に貼り付けするにはB1セルの値はコピーではなくカットが必要だと思いますが、これも「マクロの記録」だと動作ではなくテキストそのものが書き込まれてしまい、応用が効きません。 Sub A1改行カットペースト() ' ' A1改行カットペースト Macro ' ' ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & "" Range("B1").Select ActiveCell.FormulaR1C1 = "" Range("A1").Select ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & "8/7到着" Range("F4").Select End Sub "RO20-001"と"8/7到着"はA1とB1の値であって、この記述ではこのマクロをループさせた時、他の全部のセルに"RO20-001"と"8/7到着"が貼りついてしまいます。 改行やテキストのカット&ペーストの「動作」はどのように記述すれば良いのでしょうか? どなたかご存じの方がいらっしゃいましたら、教えて下さい。 よろしくお願いします。

  • VBA セルに他セルをコピペしたコメントを挿入 

    A1~A200のセルに、D1~D200の値をそれぞれコピーしたコメントを挿入するマクロを作ろうとしています。 A1に、何も書いていないコメントを挿入することはできました。 Dim i As Long For i = 1 To 200 Range("A" & i).AddComment Range("A" & i).Comment.Visible = False Next i End Sub このコメントに、D1~D200の値を貼り付けたい場合は(A1にはD1の値を、A2にはD2の値といった具合)どのように書けばよいのでしょうか? Private Sub Worksheet_Change という記述になるのかと思いますが、うまくいかないのでどなたかご存じでしたら教えてください。 よろしくお願いします。

  • Excel ブックのリネームがうまくできません

    windows10,microsoft365使用の超初心者です。 デスクトップにフォルダ「計算」があります。その中に令和2年度計算.xlsmとフォルダ「実績」があります。フォルダ実績の中に令和2年9月実績.xlsxがあります。 このファイルの名前を変えたくて、下記コードをみつけました。 実行するとダイアログボックスに、令和2年度計算.xlsmと入っています。このボックスのなかに令和2年9月実績.xlsxを表示するには、 コードをどう変えたらいいか教えていただきたいです。よろしくお願いします。 Sub File_Name() Dim Cur_Path As String 'ファイルのパス' Dim Cur_Name As String '元のファイル名' Dim New_Name As String '変更後のファイル名' 'ファイルのパス、ファイル名の読み込み' Cur_Path = ThisWorkbook.Path Cur_Name = ThisWorkbook.Name 'インプットボックスの表示とファイル名の変更' New_Name = InputBox(Prompt:="ファイル名を入力して下さい。", Default:=Cur_Name) '「キャンセルボタン」または「×ボタン」を押した場合' If New_Name = "" Then Exit Sub Else End If 'ファイルの別名保存して閉じて再度開く' ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Workbooks.Open Cur_Path & "\" & New_Name 'ファイルの別名保存して閉じて再度開く' If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then Kill Cur_Path & "\" & Cur_Name Else End If End Sub

    • ベストアンサー
    • すぐに回答を!
    • aitaine
    • Visual Basic
    • 回答数 10
  • とあるシートのB列の値かつC列の値と、とあるフォル

    とあるシートのB列の値かつC列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? 現在、とあるシートのB列の値と、とあるフォルダ内にあるファイルの名称が部分一致した際に、そのファイルを移動先のフォルダへと移動させるVBAは作成することができました(以下参照) しかし、二つの条件(B列の値かつC列の値(AND?))が部分一致したときのやり方が分からなく困っております、VBA初心者のためどうか教えていただけないでしょうか? Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\"'移動先のフォルダの設定 Const xTo As String = "C:\after\"'アクティブになっているシートのB列の値とC:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm &"*"&.Value &"*") Do While xFile <>""Name xFrm &xFile As xTo &xFile xFile = Dir() Loop End With Next i End With End Sub

  • 参照データの量が毎回決まっていない計算式について

    関数に不慣れなためお伺いできればと存じます。 したいことは以下の通りです。 (1)収支(2)勝率(3)損益比率を出したいと思っています。 その際、参照のために呼び込むデータの行数は毎回決まっていないため、 最終行を指定せずに計算できる式を探しています。 ※参照データを呼び込んだら、予め仕込んである関数によってそのときの最終行までの計算を行ってくれる式 ひとまず、添付画像にあるように 【I列】回収額をもとに(1)収支を出す計算 【J列】収支をもとに(2)勝率を出す計算 【J列】収支をもとに(3)損益比率を出す計算 の関数を作ってみたのですが、(参照する回収額の行数が毎回、決まっていないため) 収支、勝率、損益比率の式をその都度、変化する最終行までのデータをもとに計算を行うようにするにはどのように関数を変えればよいでしょうか。 なお、勝率については収支が0のときは勝ちに含めないため">1"としています。 それぞれ、式が成り立たないためとりあえずの範囲(3行目とか8行目とか)を入力しています。 【I列】 回収 【J列】 収支=I3-H3 【K列】勝率=COUNTIF(J$3:J3,">1")/COUNTA(J$3:J3)*100 ※0は勝ちに含めません 【L列】損益比率 =AVERAGEIF(J$3:J8,">0")/-AVERAGEIF(J$3:J8,"<0") ご査収いただけますと幸いです。

  • CSV形式で出力後、開くときの警告メッセージについ

    いつもお世話になっております。 ACCESSからデータをCSV形式で出力後、ファイルを開くときに添付のような警告メッセージが表示されます。[はい]をクリックすればファイルは開くことができるのですが、警告メッセージが表示されないようにするにはどうしたらいいでしょうか? xlsxのテンプレートを開き、そこにデータを書き出して、csvで保存するようになっています。csv形式で出力したことがないので、csvのFormatを指定する必要があると思っていますが、どうしたらいいでしょうか? ご教授お願いいたします。 Private Sub CMD_Expo_DblClick(Cancel As Integer) On Error GoTo Err_FileDialog_Click Dim strsql As String Dim strTemplate As String Dim strFileName As String Dim ExpFileName As String Dim xlapp As Object Dim xlWB As Object Dim myCn As New ADODB.Connection Dim myRs As New ADODB.Recordset 'ファイル名作成 ExpFileName = "SNDFILE" & Format(Date, "yyyymmdd") strFileName = GetFileName(False, "", "", ExpFileName & ".csv") 'EXCELアプリケーションを起動 Set xlapp = CreateObject("Excel.Application") 'セットする過程が見えないよう一旦不可視 xlapp.Visible = False Set myCn = CurrentProject.Connection strsql = "Q_BOFAXExpo_MJ" 'レコードセットオープン myRs.Open strsql, myCn, adOpenForwardOnly, adLockReadOnly With xlapp 'テンプレートを開く strTemplate = Application.CurrentProject.Path & "\" & "SNDFILE.xlsx" Set xlWB = .Workbooks.Open(strTemplate) 'テンプレートファイルが存在しないときはエラー If Dir(strTemplate) = "" Then MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー" .Visible = True .Quit Exit Sub End If 'テンプレートファイルオープン .Workbooks.Open strTemplate '結果値出力処理(1行目にヘッダーを表示しているので、2行目1列目からセット xlWB.Worksheets("Sheet1").Cells(1, 1).CopyFromRecordset myRs '完了したら保存 If Len(strFileName) = 0 Then xlWB.Close SaveChanges:=False xlapp.Quit MsgBox "処理を中止します。", vbOKOnly + vbInformation Exit Sub Else xlWB.SaveAs FileName:=strFileName End If MsgBox "BOFAX用のファイルの出力が完了しました。", vbOKOnly + vbInformation End With Set myRs = Nothing: Close Set myCn = Nothing: Close 'Excelを終了します xlapp.Quit Exit Sub Exit_FileDialog_Click: Exit Sub Err_FileDialog_Click: MsgBox "予期せぬエラーが発生しました" & Chr(13) & _ "エラーナンバー:" & Err.Number & Chr(13) & _ "エラー内容:" & Err.Description, vbOKOnly End Resume Exit_FileDialog_Click End Sub

  • テキストデータExcel取込時の文字化け、その他

    VBA初心者です。 やりたいことは以下の通りです。 カンマ区切りの文字が記載された.txtデータをExcelファイルに取り込みたいと思っています。 (1)自動でフォルダを開いて手動で任意のテキストデータを選ぶ (2)データを文字 化けなくカンマ区切りでセルごとにExcelに表示 (3)元データの.txtはファイルによって空白行が1行のときもあれば2行のときもありまちまちなので自動で空白行をスキップして呼び込みたい (4)呼び込んだ.txtの内容を元に読み込先のExcelに関数(I列に来るべき.txtのデータを参照してJ列「収支」K列「勝率」が出る)が仕込んであるが、ファイルによってデータの行数が違うため最終行を取得したい 特定の.txtファイルではなくこちらで選べるようにしたいので以下に示したソースの通りGetOpenFilenameで自動でファイルを開いて手動で選べるようにしています。 その際、一部別の漢字に変換されたり、カンマがひとつだけ・に代わっていたり文字化けがあります。 呼び込みたい.txtは空白行が1行あったり、2行あったりするのでそこをスキップして純粋に文字のある行から取り込みたい。読み込み先のExcelには事前に項目を作っているため、空白行をスキップできれば自動的に項目の下にデータが表示されるようになっています。※予め空白のないテキストを呼び込んでテストすると(文字化けは別として)上手くいきました。 (4)は難しくてもせめて(1)~(3)までは自力でできないかと調べていますがうまくいきません。UTF-8をANTI形式に保存しても直ったり直らなかったり、またVBAのADODB.Streamオブジェクト(Microsoft ActiveX Data Objects x.x Library)を試そうとするもファイルパスやターゲットで特定のファイルを指定する部分があり、それを指定しないで使うにはどうすればいいのかがわかりません。 ご査収いただけましたら嬉しいです。 下記はネットのソースを一部直して作成。これを利用してできないでしょうか。 Option Explicit '=================================================================================================== Private Const g_cnsTitle As String = "テキストファイル読み込み" Private Const g_cnsFilter As String = "全てのファイル (*.*),*.*" Sub Txt読み込み() Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim i As Long, j As Long varFileName = Application.GetOpenFilename(FileFilter:="txtファイル(*.txt),*.txt", _ Title:="txtファイルの選択") If varFileName = False Then Exit Sub End If intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'txtファイルをオープン i = 0 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み i = i + 1 strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For j = 0 To UBound(strSplit) Cells(i, j + 1) = strSplit(j) Next '配列をそのまま入れる方法も、ただし全て文字列として入力される 'Range(Cells(i, 1), Cells(i, UBound(strSplit) + 1)) = strSplit Loop Close #intFree End Sub

  • 助けなてください。

    コードが書けず困ってます。ExcelでVBAのコードで以下の作業が出来ずに困ってます。 複数選択したセルの行を取得して 各行の指定したセルを変数に格納、または配列を使い別ブックに貼り付ける 選択した行をコピーし別ブックに貼り付けたいのですが、項目の位置が違うため行ごと貼り付けれないのと、変数に格納して変数を使い回したいと言う上司の要望により配列で別ブックに貼り付けたいのですが 複数選択した行をセルごとに変数に格納させるのがよく分かりません。 全くコードが書けずにいます。 どなたか、VBAコードを教えていただけないでしょうか。 出来れば小学生にも分かるくらい、まるまるもらえると助かります。 心ある方助けていただけましたら幸いです。 よろしくお願いします。

  • ユーザフォームのボタンにハイパーリンクを割当てたい

    VBAの質問になります。 ユーザフォームのボタンにハイパーリンクを割り当て、ボタンを押すとそのアドレスのHPを表示するパターンは、通常下記のようにイベントハンドラにて定義すると思いますが、 Private Sub CommandButton3_Click() If InStr(1, Range("C5"), "https://") > 0 Then ActiveWorkbook.FollowHyperlink Address:=Range("C5") End If ボタン数が可変の場合、上記イベント関数がどこまで存在するかわからない時にはxxx_clickを定義しておけません。 そのため、ユーザフォームのイニシャライズ時に、ボタンに、上記のように参照アドレスのリンクをセットして(イニシャライズの時にはボタン数がわかります)、ボタンが押された時にはその定義されたアドレスに無条件に飛んでいくようにできないものでしょうか。 (ボタンを押した際、xxx_click()の中で判断して飛ばすのではなく。xxx_click()を定義していなくても飛んでいってほしい) 方法があれば、ご教授のほどよろしくお願いいたします。