Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

84 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80808】Re:エラー時のスキップ処理について

ピンク - 19/5/15(水) 11:35 -


	引用なし

	パスワード

▼Hiroshi さん：
Sub シート選択()
　　Dim strSN() As String
　　Dim i As Long, j As Long, k As Long
　　
　　For i = 1 To 100
　　　　For j = 2 To 6 Step 2
　　　　　　If ActiveSheet.Cells(i, j).Value <> "" Then
　　　　　　　　k = k + 1
　　　　　　　　ReDim Preserve strSN(1 To k) As String
　　　　　　　　strSN(k) = ActiveSheet.Cells(i, j).Value
　　　　　　End If
　　　　Next j
　　　　Worksheets(strSN).PrintOut
　　　　Erase strSN
　　　　k = 0
　　Next i
End Sub

・ツリー全体表示


	【80807】エラー時のスキップ処理について

Hiroshi - 19/5/15(水) 10:09 -


	引用なし

	パスワード

お世話になります。

　それぞれのセルにハイパーリンクを設定してシートをセット印刷するマクロを組んだのですが、「Ｄ」若しくは「Ｆ」の先がない場合があり、その際にその行そのものを印刷せずに次行へスキップしてしまいます。
　
　これを「Ｂ、Ｄ」若しくは「Ｂ、Ｆ」の組み合わせで印刷するようにしたいのですが、エラー処理、if構文、スキップ等試したのですが上手く動作しませんでした。ご教授いただきたいのでよろしくお願い致します。

Sub シート選択()

　　Dim strSN(1 To 3) As String
　　Dim i As Long
　　
　　On Error Resume Next
　　
　　For i = 1 To 100
　　
　　strSN(1) = ActiveSheet.Range("B" & i).Value
　　strSN(2) = ActiveSheet.Range("D" & i).Value
　　strSN(3) = ActiveSheet.Range("F" & i).Value
　　
　　Worksheets(strSN).PrintOut
　　
　　Next i
　　　
End Sub

・ツリー全体表示


	【80806】Re:複数のセルに入れた数字のワードシー...

サル - 19/5/15(水) 9:32 -


	引用なし

	パスワード

マナさん

ご返信いただきありがとうございます。
又、お礼が遅くなり申し訳ありません。

当方、VBAはいまだ始めたばかなので、非常に助かります。

重ねてどうもありがとうございます。

・ツリー全体表示


	【80805】Re:Excelの新元号対応(?)で、ExcelVBAに...

マナ - 19/5/14(火) 18:58 -


	引用なし

	パスワード

▼令和で困り者さん：

>まだ不明な点がありますので、その時はまたお願いいたします。

解決したからといって、マルチポスト先を放置しないほうがよいです。
誰も回答してくれなくなりますよ。

・ツリー全体表示


	【80804】Re:Excelの新元号対応(?)で、ExcelVBAに...

令和で困り者 - 19/5/14(火) 17:53 -


	引用なし

	パスワード

ピンクさま

いろいろお手数をおかけしました。
お礼申し上げます!!
まだ不明な点がありますので、その時はまたお願いいたします。

▼ピンクさん：
>▼令和で困り者さん：　　
>　　strBuff = Replace(strDate, "年", "/")
>　　s = InStr(strBuff, "/")
>　　strBuff = Replace(strBuff, "月", "/")
>　　strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"
>　　If s = 3 Then
>　　　　strBuff = Mid(strBuff, 1, 2) + 1988 & Mid(strBuff, 3, 6)
>　　ElseIf s = 2 Then
>　　　　strBuff = Mid(strBuff, 1, 1) + 2018 & Mid(strBuff, 2, 6)
>　　End If
>
>あなたの記述は
>　Elself
>正解は
>　ElseIf

・ツリー全体表示


	【80803】Re:Excelの新元号対応(?)で、ExcelVBAに...

ピンク - 19/5/14(火) 17:30 -


	引用なし

	パスワード

▼令和で困り者さん：　　
　　strBuff = Replace(strDate, "年", "/")
　　s = InStr(strBuff, "/")
　　strBuff = Replace(strBuff, "月", "/")
　　strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"
　　If s = 3 Then
　　　　strBuff = Mid(strBuff, 1, 2) + 1988 & Mid(strBuff, 3, 6)
　　ElseIf s = 2 Then
　　　　strBuff = Mid(strBuff, 1, 1) + 2018 & Mid(strBuff, 2, 6)
　　End If

あなたの記述は
　Elself
正解は
　ElseIf

・ツリー全体表示


	【80802】Re:Excelの新元号対応(?)で、ExcelVBAに...

令和で困り者 - 19/5/14(火) 14:06 -


	引用なし

	パスワード

▼ピンク様：

以下のようでよろしいでしょうか？

「Elself s = 2 Then」でコンパイルエラー(修正候補：ステートメントの最後)が表示されてしまいます...

　　strBuff = Replace(strDate, "年", "/")
　　s = InStr(strBuff, "/")
　　strBuff = Replace(strBuff, "月", "/")
　　strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"
　　If s = 3 Then
　　strBuff = Mid(strBuff, 1, 2) + 1988 & Mid(strBuff, 3, 6)
　　Elself s = 2 Then
　　strBuff = Mid(strBuff, 1, 1) + 2018 & Mid(strBuff, 2, 6)
End If

　　With ActiveWorkbook.Sheets(strDate).Tab
　　　　.Color = dblColor(intI)
　　　　.TintAndShade = 0
　　End With

End Sub

>▼令和で困り者さん：
>strBuff = Replace(strDate, "年", "/")
>s = InStr(strBuff, "/")
>strBuff = Replace(strBuff, "月", "/")
>strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"
>If s = 3 Then
>　　strBuff = Mid(strBuff, 1, 2) + 1988 & Mid(strBuff, 3, 6)
>ElseIf s = 2 Then
>　　strBuff = Mid(strBuff, 1, 1) + 2018 & Mid(strBuff, 2, 6)
>End If

・ツリー全体表示


	【80801】Re:Excelの新元号対応(?)で、ExcelVBAに...

ピンク - 19/5/14(火) 11:17 -


	引用なし

	パスワード

▼令和で困り者さん：
strBuff = Replace(strDate, "年", "/")
s = InStr(strBuff, "/")
strBuff = Replace(strBuff, "月", "/")
strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"
If s = 3 Then
　　strBuff = Mid(strBuff, 1, 2) + 1988 & Mid(strBuff, 3, 6)
ElseIf s = 2 Then
　　strBuff = Mid(strBuff, 1, 1) + 2018 & Mid(strBuff, 2, 6)
End If

・ツリー全体表示


	【80800】Re:Excelの新元号対応(?)で、ExcelVBAに...

令和で困り者 - 19/5/14(火) 9:19 -


	引用なし

	パスワード

マナ様

ご連絡ありがとうございます。
始めからで申し訳ありませんが、お教え頂きました以下の
９行を何処に差し込めばいいのでしょうか？
よろしくお願いいたします。

▼マナさん：
>▼令和で困り者さん：
>
>２年以上前は無視して良いなら
>
>Sub test()
>　　Dim shn As String
>　　
>　　shn = "1年5月"
>
>　　If Val(shn) > 29 Then
>　　　　MsgBox Format("H" & shn, "yyyy/mm/01")
>　　Else
>　　　　MsgBox Format("R" & shn, "yyyy/mm/01")
>　　End If
>　　
>End Sub

・ツリー全体表示


	【80799】Re:データを別アプリに再入力する方法

たる - 19/5/13(月) 21:51 -


	引用なし

	パスワード

▼マナさん：
>▼たるさん：
>
>ご要望のことは不可能です。

了解です。お答えいただきありがとうございました。

・ツリー全体表示


	【80798】Re:データを別アプリに再入力する方法

マナ - 19/5/13(月) 19:33 -


	引用なし

	パスワード

▼たるさん：

ご要望のことは不可能です。

・ツリー全体表示


	【80797】Re:Excelの新元号対応(?)で、ExcelVBAに...

マナ - 19/5/13(月) 19:30 -


	引用なし

	パスワード

▼令和で困り者さん：

２年以上前は無視して良いなら

Sub test()
　　Dim shn As String
　　
　　shn = "1年5月"

　　If Val(shn) > 29 Then
　　　　MsgBox Format("H" & shn, "yyyy/mm/01")
　　Else
　　　　MsgBox Format("R" & shn, "yyyy/mm/01")
　　End If
　　
End Sub

・ツリー全体表示


	【80796】Excelの新元号対応(?)で、ExcelVBAにバグ...

令和で困り者 - 19/5/13(月) 17:19 -


	引用なし

	パスワード

MS-Offceを新元号対応にしたところ、前任者が作成した年間スケジュール(Excel VBA)に
次のエラーが発生しました。

Sheet名[３１年４月]までは正常でしたが、Sheet[１年５月]を作り掛けると
「実行時エラー'13'　型が一致しません」となり
「 intI = CInt(Mid(strBuff, 1, 2)) + 1988」行が黄色となります。

また、以下１行目の「/」を外すと、Sheet[１年９月]まで作成後、同様のエラー表示になります。
（桁数が問題かと色々探して見てみましたが...）

解決方法のご教示をお願いできれば助かります。

strBuff = Replace(strDate, "年", "/")　　　　　　　　　---->strDate "１年５月"　strbuff ""　　　　　 int:10
strBuff = Replace(strBuff, "月", "/")　　　　　　　　　---->strDate "１年５月"　strbuff "１/５月"　　int:10
strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"　　　---->strDate "１年５月"　strbuff "１/５/"　　 int:10
intI = CInt(Mid(strBuff, 1, 2)) + 1988　　　　　　　　 ---->strDate "１年５月"　strbuff "1/5/01"　　 int:10
strBuff = CStr(intI) & Mid(strBuff, 3, 6)

ちなみにSheet名[３１年４月]の場合は以下のようになります。

strBuff = Replace(strDate, "年", "/")　　　　　　　　　---->strDate "３１年４月"　strbuff ""　　　　　 int:10
strBuff = Replace(strBuff, "月", "/")　　　　　　　　　---->strDate "３１年４月"　strbuff "３１/４月"　int:10
strBuff = Trim(StrConv(strBuff, vbNarrow)) & "01"　　　---->strDate "３１年４月"　strbuff "３１/４/"　 int:10
intI = CInt(Mid(strBuff, 1, 2)) + 1988　　　　　　　　 ---->strDate "３１年４月"　strbuff "31/4/01"　　int:10
strBuff = CStr(intI) & Mid(strBuff, 3, 6)　　　　　　　---->strDate "３１年４月"　strbuff "31/4/01"　　int:2019
strBuff = DateAdd("m", -3 ,strBuff)　　　　　　　　　　---->strDate "３１年４月"　strbuff "2019/4/01"　int:2019

・ツリー全体表示


	【80795】データを別アプリに再入力する方法

たる - 19/5/13(月) 0:54 -


	引用なし

	パスワード

初めまして。
VBAにつきまして、恐縮ですがどうかご教授願います。

1.VBAで、別のアプリ内に入力されている文字を一旦コピー（保存）する。
2.コピーした内容を、別のPCから同じアプリに再入力する。

上記内容をVBAで行うことは可能でしょうか。

別のアプリというのが、社内で利用している顧客情報を入力するアプリです。
何故か貼り付けができず、直接入力しか受け付けないものなので、
コピーした内容をVBAで認識して、貼り付けではなくアプリ内に再入力はできないでしょうか。

例えば「090-1234-5678」と入力されている内容を、コピー→貼り付けではなく、
上記数字をVBAが1文字ずつ別アプリに入力できれば、と考えています。

何卒宜しくお願い致します。

・ツリー全体表示


	【80794】Re:セルに特定文字が入ったら別シートへ...

マナ - 19/5/11(土) 19:14 -


	引用なし

	パスワード

▼HIHI さん：

>以下の通りでやりましたらうまくいきました。

同じように悩み、このスレを読む方もいるかもしれません。
なので、完成したコードを提示いただけるとよいのですが…

Option Explicit

Sub test()
　　Dim rngS As Range
　　Dim rngD As Range
　　Dim rngC As Range
　　
　　Set rngS = Sheets("Sheet1").Range("A1").CurrentRegion
　　Set rngD = Sheets("Sheet2").Range("C12:I12")
　　
　　Set rngC = rngS(1).Offset(rngS.Rows.Count + 1).Resize(2)
　　rngC(2).Formula = "=A2=1"
　　
　　rngS.AdvancedFilter xlFilterCopy, rngC, rngD
　　
　　rngC.ClearContents

End Sub

・ツリー全体表示


	【80793】Re:複数のセルに入れた数字のワードシー...

マナ - 19/5/10(金) 21:54 -


	引用なし

	パスワード

▼サルさん：

GetObjectで、その文書を開くとよいです。
ht　tp://www7b.biglobe.ne.jp/~whitetiger/ex/ex2002074.html

実際は、word文書を開いた後で、何らかの処理を実行するのではありませんか。
すでに開いていた場合ですが、エラーを出さないのはよいとして、
そのまま継続して問題ないのでしょうか？
データ取得だけであれば問題ないのかもしれませんが…

・ツリー全体表示


	【80792】Re:VBAでグラフの特定要素を非表示にする

マナ - 19/5/10(金) 20:51 -


	引用なし

	パスワード

▼bonkan さん：

>
>Office365だとコードが出力されるとのことと追加情報もありがとうございます。
>エクセル自体のVersionアップも今後は視野に入れていきます。

そうではなくて、「データソーすの選択」画面からだと記録されないのは同じです。
なので、リンク先の手順ならば、2013でも記録されるのではというつもりでした。

・ツリー全体表示


	【80789】Re:f2+enterをマクロを使って押させたい

マナ - 19/5/10(金) 19:30 -


	引用なし

	パスワード

▼Mp さん：

>ブックAのセルにあるフォルダのパスを読み込んで、ブックBに貼り付けました。
>そのあとそのパスをf2+enterで水色？に表示させてクリックしたらそのフォルダを開けるようにしたいです。

こことかを参考になりませんか
ht　tps://excelwork.info/excel/hyperlinks/

　

・ツリー全体表示


	【80788】複数のセルに入れた数字のワードシートを...

サル - 19/5/10(金) 16:37 -


	引用なし

	パスワード

はじめまして。

エクセルでE5のセルとE6のセルに入れた文字列のワードファイルを開ける方法と、そのシートがすでに開いている場合と、存在しない場合のエラーがでないようにするコードを教えていただけないでしょうか？

以下のコードはE5に　"1"を入れた時に１のファイル名のワードを開けるところまではできましたが、その後、いろいろ探したり、やってみたりしましたがうまくいきません。よろしくお願いします。

Sub OpenBook()

With CreateObject("word.application")
　 .Visible = True
　 .documents.Open "C:\Users\サル\Documents\thinkpad\住所録\" & Range("E5").Value
　
　End With

end sub

・ツリー全体表示


	【80787】Re:セルに特定文字が入ったら別シートへ...

HIHI - 19/5/10(金) 12:22 -


	引用なし

	パスワード

▼マナさん：

ありがとうございました。
以下の通りでやりましたらうまくいきました。

▼マナさん：
>▼HIHI さん：
>
>>シート1の1行目は見出しがあります。
>>シート12も見出しあります。シート1と同じ項目の見出しです。
>>1以外は空欄です。
>
>フィルタの詳細設定（フィルタオプション）が使えると思います。
>まずは、手操作で試してみるとよいです。
>期待通りの結果になるようなら、その操作を「マクロの記録」です。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

84 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free