Excel VBA質問箱 IV

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

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


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

336 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【75704】Re:区切り位置

γ - 14/6/16(月) 20:38 -


	引用なし

	パスワード

>同じ動作でもっと簡潔に書けないでしょうか。

TextToColumnsメソッドのヘルプで、引数の意味を確認してください。
引数を省略してみて、動作が変わらないか確認することになりますが、
こういうものは余り省略しないほうがいいように思います。

・ツリー全体表示


	【75703】Re:補足

γ - 14/6/16(月) 19:57 -


	引用なし

	パスワード

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
の直ぐ次の行に
　　Debug.Print Target.Address
を挿入してみてください。

> 売上伝票のC20、C21、C22、C23、C24の5つをダブルクリックすると
を実行したときに、イミディエイトウインドウに表示される結果を教えて下さい。

# 思い当たる節が無いわけではないが、ここは一つ正攻法で行きましょう。
# 問題解決の手法自体も勉強する価値があるものだからです。

・ツリー全体表示


	【75702】Re:区切り位置

インフェルエンス - 14/6/16(月) 17:18 -


	引用なし

	パスワード

For n = 7 To 42 Step3
fWB.ActiveSheet.Range(Cells(9,n),Cells(13,n)).Select
Selection.TextToColumnsDestination:=Cells(9,n),DataType:=xlDelimited,_
TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,_
Semicolon:=False,Comma:=False,Space:=False,Other:=False,FieldInfo_
:=Array(1,1),TrailingMinusNumbers:=True
Nextn

上記で欲しい結果になりました。
同じ動作でもっと簡潔に書けないでしょうか。

・ツリー全体表示


	【75701】区切り位置

インフェルエンス - 14/6/16(月) 17:06 -


	引用なし

	パスワード

Range("G9:G13").Select
Selection.TextToColumnsDestination:=Range("G9"),DataType:=xlDelimited,_
TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,_
Semicolon:=False,Comma:=False,Space:=False,Other:=False,FieldInfo_
:=Array(1,1),TrailingMinusNumbers:=True

Range("J9:J13").Select
Selection.TextToColumnsDestination:=Range("J9"),DataType:=xlDelimited,_
TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,_
Semicolon:=False,Comma:=False,Space:=False,Other:=False,FieldInfo_
:=Array(1,1),TrailingMinusNumbers:=True

Range("M9:M13").Select
Selection.TextToColumnsDestination:=Range("M9"),DataType:=xlDelimited,_
TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False,Tab:=True,_
Semicolon:=False,Comma:=False,Space:=False,Other:=False,FieldInfo_
:=Array(1,1),TrailingMinusNumbers:=True

G,J,M,P・・・ANまで列を3つ飛ばしで区切り位置を標準にしていきたいのですが、
for文使えばうまいことできそうな気がするのですが、書き方がわかりません。

よろしくお願いします。

・ツリー全体表示


	【75700】Re:オートシェイプの表示・非表示　visi...

hoda - 14/6/16(月) 9:32 -


	引用なし

	パスワード

とおりすがりさん
どうもありがとうございます！
できました！！！！！

原因は分かりませんが、探してみると、目的のオートシェイプ以外ばかりを指定
しており、、、、
とりあえず、目的のオートシェイプ以外を全て削除してみました。
そうすると、希望通りにソフトが走ってくれました！
その後、削除したオートシェイプを元に戻しても、ちゃんと動いています。

ありがとうございました！！

・ツリー全体表示


	【75699】Re:補足

hamako - 14/6/16(月) 9:02 -


	引用なし

	パスワード

返信遅くなり申し訳ございません。

ｼｰﾄ2（売上伝票画面)のD12をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ3(得意先ｺｰﾄﾞ)へ飛ぶ
ｼｰﾄ2（売上伝票画面)のC20をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ4（作業ｺｰﾄﾞ)へ飛ぶ

>>> それは出来ていると思います。
→やはりできないのですがなぜでしょうか。。

>>> 売上伝票のC20、C21、C22、C23、C24の5つをダブルクリックすると
>のところでしょう。
>Select Caseのヘルプをよく確認して下さい。
>　　　　Case "$C$20", "$C$21", "$C$22", "$C$23", "$C$24"
>　　　　　　 Sheets(shName4).Activate
>のようにまとめて記述することができます。

→ｼｰﾄ4には飛ばないのですが、
C20、C21、C22、C23、C24のいずれかをﾀﾞﾌﾞﾙｸﾘｯｸした後、
自分で手動でｼｰﾄをｼｰﾄ4に移動すれば、ｼｰﾄ4内のセルをﾀﾞﾌﾞﾙｸﾘｯｸすると
挿入＆ｼｰﾄ2に戻るようになりました！！
あとは一番初めにﾀﾞﾌﾞﾙｸﾘｯｸでｼｰﾄ4に飛べば完璧なのですが・・・

以下、今のｺｰﾄﾞです。
どこがおかしいかわかりますでしょうか。。

Dim ToCell As Range
Const shName1 As String = "はじめに"
Const shName2 As String = "売上伝票"
Const shName3 As String = "得意先ｺｰﾄﾞ"
Const shName4 As String = "作業ｺｰﾄﾞ"

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
　　Cancel = True
　　If Sh Is Sheets(shName3) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName4) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName2) Then
　　　　Set ToCell = Target
　　　　Select Case Target.Address
　　　　Case "$D$12"
　　　　　　 Sheets(shName3).Activate
　　　　Case "$C$20", "$C$21", "$C$22", "$C$23", "$C$24"
　　　　　　 Sheets(shName4).Activate

　　　　End Select
　　End If
End Sub

・ツリー全体表示


	【75698】Re:「」で挟まれた部分のみの書式を変え...

γ - 14/6/15(日) 21:42 -


	引用なし

	パスワード

返事がありませんので、勝手にコメントします。

Findメソッドで"「"を検索し、
正規表現を用いて、"「"と"」"で挟まれた文字列の位置を取得しています。
普通にInstrだけでもできると思いますが、勢いで正規表現を使いました。

「」そのものを入れるかどうかや、
Instrを使った解法など、修正はそちらでどうぞ。

Dim re As Object
Sub test()
　　Dim c As Range
　　Dim firstAddress As String
　　
　　Set re = CreateObject("VBScript.RegExp")
　　re.Pattern = "「(.*?)」"
　　re.Global = True

　　With Worksheets(1).UsedRange
　　　　Set c = .Find(What:="「", After:=.Range("A1"), LookIn:=xlFormulas, _
　　　　　　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, _
　　　　　　　　　　　SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　　　　　　MatchByte:=False, SearchFormat:=False)
　　　　If Not c Is Nothing Then
　　　　　　firstAddress = c.Address
　　　　　　Do
　　　　　　　　Call do_replace(c)
　　　　　　　　Set c = .FindNext(c)
　　　　　　Loop While Not c Is Nothing And c.Address <> firstAddress
　　　　End If
　　End With
End Sub

Function do_replace(c As Range)
　　Dim s　　　 As String
　　Dim matches As Object
　　Dim m　　　 As Object
　　Dim st　　　As Long
　　Dim myLen　 As Long

　　s = c.Text
　　Set matches = re.Execute(s)
　　For Each m In matches
　　　　st = m.FirstIndex + 2
　　　　myLen = Len(m.SubMatches(0))
　　　　With c.Characters(Start:=st, Length:=myLen).Font
　　　　　　.FontStyle = "太字"
　　　　　　.Underline = xlUnderlineStyleSingle
　　　　End With
　　Next
End Function

・ツリー全体表示


	【75697】Re:フォルダの検索、一致した場合のコピ...

ペンネーム船長 - 14/6/15(日) 21:04 -


	引用なし

	パスワード

下記コードで思う通りの動きになりました。
ご指摘のコード
Set　FSO＝Nothig
を削除したら上手くゆきました。
有難う御座いました。

Private Sub CommandButton1_Click()
Dim FSO As Object, Folder As Variant
Dim ws As Worksheet
Dim Lst As Variant
Dim i As Integer
Dim FolPath1 As String
Dim FolPath2 As String
Dim CopyFrom As String
Dim CopyTo As String
Set ws = Worksheets("一覧表")
Set FSO = CreateObject("Scripting.FileSystemObject")
FolPath1 = "C:\Users\○△□\Desktop\Aフォルダー"
FolPath2 = "C:\Users\○△□\Desktop\Bフォルダー"
　For Each Folder In FSO.GetFolder(FolPath1).SubFolders
　　For i = 1 To 100
　　　Set Lst = Workbooks(1).Worksheets(1).Cells(i + 1, 1)
　　　If Folder.Path = FolPath1 & "\" & Lst Then
　　　　CopyFrom = FSO.BuildPath(FolPath1, Folder.Name)
　　　　CopyTo = FSO.BuildPath(FolPath2, Folder.Name)
　　　　FSO.CopyFolder CopyFrom, CopyTo
　　　End If
　　Next i
　Next Folder
End Sub

・ツリー全体表示


	【75696】Re:「」で挟まれた部分のみの書式を変え...

γ - 14/6/15(日) 20:45 -


	引用なし

	パスワード

▼みつをさん：
>「」で挟まれているスペースや文字の書式を、下線部や太文字にしたりしたいのですが、
>どのような記載をすればできるのでしょうか？
手始めに、一つのセルでその動作をマクロ記録してみたらどうなりますか？

・ツリー全体表示


	【75695】「」で挟まれた部分のみの書式を変えたい...

みつを - 14/6/15(日) 17:09 -


	引用なし

	パスワード

Sheet1 内の
「」で挟まれているスペースや文字の書式を、下線部や太文字にしたりしたいのですが、
どのような記載をすればできるのでしょうか？

宜しくお願いします。

・ツリー全体表示


	【75694】Re:フォルダの検索、一致した場合のコピ...

γ - 14/6/15(日) 4:51 -


	引用なし

	パスワード

Set FSO = Nothing
の位置がおかしいです。
# 全体をよく見ていませんが。

・ツリー全体表示


	【75693】フォルダの検索、一致した場合のコピー方...

ペンネーム船長 - 14/6/15(日) 1:38 -


	引用なし

	パスワード

初めてお世話になります。

【やりたい事】
・Aフォルダーの中に複数のフォルダーがあります。
　エクセルのA列にフォルダー名が列挙してあります。
　このフォルダー一覧とＡフォルダーの中を照合し、合致したフォルダーがあれば　そのフォルダーをＢフォルダーへコピーする。
　マクロは、一覧表のあるエクセルに記述するものとします。

【コードを記述しましたが上手く動きません】
以下のコードを実行させたのですが、1フォルダーだけコピーが成功し、「CopyFrom = FSO.BuildPath(FolPath1, Folder.Name)」の行が黄色になって止まってしまいました。
間違っているところを指摘して下さると助かります。

Private Sub CommandButton1_Click()

Dim FSO As Object, Folder As Variant
Dim ws As Worksheet
Dim Rist As Variant
Dim i As Integer
Dim FolPath1 As String
Dim FolPath2 As String
Dim CopyFrom　 As String
Dim CopyTo　　 As String
　　
Set ws = Worksheets("一覧表")
Set FSO = CreateObject("Scripting.FileSystemObject")

FolPath1 = "C:\Users\○△□\Desktop\Aフォルダー"
FolPath2 = "C:\Users\○△□\Desktop\Bフォルダー"

　　For Each Folder In FSO.GetFolder(FolPath1).SubFolders
　　　　For i = 1 To 1000
　　Set Rist = ThisWorkbook.Worksheets("一覧表").Cells(i + 1, 1)
　　　　If Folder.Path = FolPath1 & "\" & Rist Then
　　　　　'Aフォルダーの中のフォルダー名がリストと一致した場合、そのフォルダーをBフォルダーへコピーする
　　　　　CopyFrom = FSO.BuildPath(FolPath1, Folder.Name)
　　　　　CopyTo = FSO.BuildPath(FolPath2, Folder.Name)
　　　　　FSO.CopyFolder CopyFrom, CopyTo
　　　　　Set FSO = Nothing
　　　 End If
　　　 Next i
　 Next Folder
　
End Sub

・ツリー全体表示


	【75692】Re:補足

γ - 14/6/13(金) 21:13 -


	引用なし

	パスワード

▼hamako さん：
>しかし下記の事ができません。
>ｼｰﾄ2（売上伝票画面)のD12をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ3(得意先ｺｰﾄﾞ)へ飛ぶ
>ｼｰﾄ2（売上伝票画面)のC20をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ4（作業ｺｰﾄﾞ)へ飛ぶ

それは出来ていると思います。

> 売上伝票のC20、C21、C22、C23、C24の5つをダブルクリックすると
のところでしょう。

Select Caseのヘルプをよく確認して下さい。
　　　　Case "$C$20", "$C$21", "$C$22", "$C$23", "$C$24"
　　　　　　 Sheets(shName4).Activate
のようにまとめて記述することができます。

なお、
　　　Select Case Target.Address(False,False) としておけば、　　　　　　
　　　Case "C20", "C21", "C22", "C23", "C24"
　　　のように$は不要となります。

・ツリー全体表示


	【75691】補足

hamako - 14/6/13(金) 10:58 -


	引用なし

	パスワード

さきほどの「このように加工してやってみました」というマクロだと

下記の事はできました。
D12をまずﾀﾞﾌﾞﾙｸﾘｯｸした後、
自分でｼｰﾄを移動し、ｼｰﾄ3の任意のセルをﾀﾞﾌﾞﾙｸﾘｯｸすると
ｼｰﾄ2の画面に戻ってD12に挿入される（C20・C20・C21・・も同様)

しかし下記の事ができません。
ｼｰﾄ2（売上伝票画面)のD12をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ3(得意先ｺｰﾄﾞ)へ飛ぶ
ｼｰﾄ2（売上伝票画面)のC20をﾀﾞﾌﾞﾙｸﾘｯｸ→ｼｰﾄ4（作業ｺｰﾄﾞ)へ飛ぶ

一番最初に
ネットからコピペしてできたという時のように
D12をﾀﾞﾌﾞﾙｸﾘｯｸでｼｰﾄ3へ飛ぶようにしたいのです
（一番最初のはどこのセルを選んでもｼｰﾄ3に飛んでしまうのですが)

可能なのでしょうか。

・ツリー全体表示


	【75690】Re:ﾀﾞﾌﾞﾙｸﾘｯｸでｼｰﾄ移動

hamako - 14/6/13(金) 9:36 -


	引用なし

	パスワード

返信、本当にありがとうございます。
ここまで教えて頂いてお恥ずかしく、大変申し訳ないのですが
まだできません・・・

すみません。コードの解読ができないんです。
ネットからコピペして、なんとなく加工して
なんとなくできるというばかりで。

★★★
教えて頂いた事を下記の通りにやってみたのですが、
間違っている箇所を訂正して
再度コードを送っていただけないでしょうかm(__)m
★★★

Alt+F11画面で
ThisWorkbookをダブルクリックし、そこに
頂いたコードを貼り付け（←貼り付ける場所あってますか?)

それから
質問を簡素にするために
「シート1」「Ａ１・Ｂ１」などと書いたのですが、

実際は
ｼｰﾄ1は「はじめに」という名前
ｼｰﾄ2は「売上伝票」という名前
ｼｰﾄ3は「得意先ｺｰﾄﾞ」という名前
ｼｰﾄ4は「作業ｺｰﾄﾞ」という名前

で
売上伝票(ｼｰﾄ2)画面のD12をダブルクリックすると
ｼｰﾄ3（得意先ｺｰﾄﾞ)へジャンプ希望
売上伝票のC20、C21、C22、C23、C24の5つをダブルクリックすると
ｼｰﾄ4(作業ｺｰﾄﾞ）へジャンプ希望

が本当の為、自分なりに下記のように加工しました。
（ある程度教えて頂ければ自分でできるかなと思ったのですが
全然だめでしたm(__)m・初めから言ってよ！だったら
ほんとすみません)

Dim ToCell As Range
Const shName1 As String = "はじめに"
Const shName2 As String = "売上伝票"
Const shName3 As String = "得意先ｺｰﾄﾞ"
Const shName4 As String = "作業ｺｰﾄﾞ"

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
　　Cancel = True
　　If Sh Is Sheets(shName3) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName4) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName2) Then
　　　　Set ToCell = Target
　　　　Select Case Target.Address
　　　　Case "$D$12"
　　　　　　 Sheets(shName3).Activate
　　　　Case "$C$20"
　　　　　　 Sheets(shName4).Activate
　　　　End Select
　　End If
End Sub

よろしくお願いしますm(__)m

・ツリー全体表示


	【75689】Re:フォームが消える

ゆーあ - 14/6/13(金) 9:28 -


	引用なし

	パスワード

とおりすがりさん

コメントありがとうございます。
また、返信遅くなりすみません。

今朝、エクセル起動させたら、
不具合が解消されておりました。

ご教授頂き、誠にありがとうございました。

・ツリー全体表示


	【75688】Re:フォームが消える

とおりすがり（3） - 14/6/13(金) 8:48 -


	引用なし

	パスワード

エクセルを再起動しても同じですか？

・ツリー全体表示


	【75687】Re:ﾀﾞﾌﾞﾙｸﾘｯｸでｼｰﾄ移動

γ - 14/6/13(金) 7:40 -


	引用なし

	パスワード

ちょっと恥ずかしいコードだったかな。
　　Select Case Sh.Name
　　Case shName2, shName3
　　Case shName1
　　End Select
で分岐するとよかった。

・ツリー全体表示


	【75686】Re:フォームが消える

とおりすがり（２） - 14/6/13(金) 7:07 -


	引用なし

	パスワード

付属情報入力フォームを呼び出している部分の下にDoEventsを入れると
どうなりますか？

付属情報入力フォーム.Show
DoEvents
DoEvents

・ツリー全体表示


	【75685】Re:ﾀﾞﾌﾞﾙｸﾘｯｸでｼｰﾄ移動

γ - 14/6/13(金) 7:07 -


	引用なし

	パスワード

こういうことですか。
Dim ToCell As Range
Const shName1 As String = "Sheet1"
Const shName2 As String = "Sheet2"
Const shName3 As String = "Sheet3"

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
　　Cancel = True
　　If Sh Is Sheets(shName2) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName3) Then
　　　　If ToCell Is Nothing Then
　　　　　　MsgBox "先に転記先のセルをクリックしてから、このシートでダブルクリックしてください"
　　　　　　Exit Sub
　　　　End If
　　　　ToCell.Value = Target.Value
　　　　Application.Goto ToCell
　　　　Set ToCell = Nothing
　　ElseIf Sh Is Sheets(shName1) Then
　　　　Set ToCell = Target
　　　　Select Case Target.Address
　　　　Case "$A$1"
　　　　　　 Sheets(shName2).Activate
　　　　Case "$B$1"
　　　　　　 Sheets(shName3).Activate
　　　　End Select
　　End If
End Sub

・ツリー全体表示


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

336 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free