人に聞けない痔の悩み、これでスッキリ >>

お世話になります。

VBEの右クリックに「よく使う構文の貼り付け」を追加したいと考えています。

例:右クリックメニューから"for文"→"終端セルまで"で以下の文を張り付ける
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
for i = 2 to Cells(Rows.Count, 1).End(xlUp).Select

next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

"選択範囲のコメントアウト"を追加したり、Excel側の右クリックにマクロを登録する等の方法は検索したら出てきたのですが、表題の件は見つけられませんでした。

現状、直接記入するかメモ帳から貼り付けていますが少し不便を感じています
ご存知の方がいらしたら、ぜひ教えて頂きたいですm_m

補足質問(こちらは回答不要です)
VBEのショートカットに"選択の開始"は登録出来ないでしょうか
Shiftキーとの併用で任意の範囲選択が出来ることは存じていますが、Shiftキー押しっぱなしでは運指が辛い時があります

A 回答 (4件)

こんにちは。



× for i = 2 to Cells(Rows.Count, 1).End(xlUp).Select

○ For i = 2 to Cells(Rows.Count,1).end(xlUp).Row

ご希望に叶うかは分かりませんが、個人的なことですが、ちょうど、この件について、その貼り付けするツールの作者とのやり取りをこの間までしていたばかりです。

右クリックメニューでは、知りませんが、Ctrl + Shift + R のショートカットキーで、以下を登録してあります。
Lastrow=Cells(Rows.Count,1).End(xlUp).Row
これらのコード(テンプレート)は、40項目ぐらい登録しています。

ツールの名前は、「MZ-Tools」 といいます。MZは、マジンガーZの略だそうです。
VBAのみならず、VSでも使用できる、世界的に有名なツールのひとつです。

解説は以下で出ています。
https://www.ka-net.org/blog/?p=6260

現在は、Ver.8 で、$79.5 で、日本語対応もしていませんので、日本では、あまり一般的には購入されないとは思います。それでも、かつてVer.3 (フリー)は、皆の知られたツールでした。Ver.3 は、同じ機能はありましたから、ウィルスさえ気をつければ、本家にはありませんが、探せば見つかるかと思います。
https://www.mztools.com/index.aspx

なお、その昔は、VSSという、MSのディベロッパーバージョンの中にあったのですが、これはデータベース状にしてしまい、後がとても使いづらかったです。MZ-Tools には、ショートカットキーとは別に、お好みコード・エレメントという機能もついています。
「[Excel,VBA,VBE] VBE上」の回答画像2
    • good
    • 1
この回答へのお礼

ご回答ありがとうございます。

「MZ-Tools」の存在は知っていましたが(某VBA本著者が使っていた為)、業務上導入できないので諦めていました。

>>右クリックメニューでは、知りませんが、Ctrl + Shift + R のショートカットキーで、以下を登録してあります。
まさにその機能(の代わりになるもの)を求めていました。VBE単体ではALT+αのショートカットキーしか適用出来ないんですよね...
せめて既存ショートカットキーの割り当て変更ぐらいはしたいものです
(Ctrl+Yの行削除に何度苦しめられたことか)

詳細な説明ありがとうございました。同様に困っている方の参考になればと思います。

お礼日時:2019/03/16 15:42

>Applicationオブジェクトをほとんど触ったことが無く、


そんなことはないはずです。ふつう、標準モジュールの場合、親オブジェクトはは、Application オブジェクトですから、その表示は省略しても動くはずです。

>よみ "ふぉいえ" (For i Endの略)
なるほど、単語登録を忘れない限りは大丈夫ですね。
「ん」を最初につけると良いとか聞きましたが、そういう方法もありますね。

>VBA Editor上で動作する、Application.Undoに該当するものがあるのでしょうか?

それは、Ctrl+z のことでしょうか。

今、こういう質問は見られなくなりましたね。Wscript.Shell を使う方法があります。つまり、Wscript を利用します。VBAの外から命令するので、VBAからは直接影響を受けなくなります。

話が戻りますが、ちょっと思いついた単語・文章登録の貼り付けプログラムですが、登録した文をクリツプボードに入れる方法があります。ふつうは、UserForm を利用しますが、それ以外の究極のクリップボードのコードです。過去のコードを利用して、たまたま出来てしまったので、紹介しておきます。これは、Windows側のクリップボードを利用した本格的なものです。ただし、エラー処理はされていません。Shortcut で呼び出して、数字や文字を入れます。クリックボードに入れたら、Ctrl + V で貼り付けてください。これをアドインなどにすれば、かなり本格的なものになります。
'---------------------------
'Excel は、32bit 用
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long


Sub SelectSentences()
Dim num As Variant
Dim msg As String
num = Application.InputBox("数字を入れてください。", "SetenceLists", Type:=1)
If num = False Then Exit Sub
Select Case num
Case 1
 msg = "Lastrow = Cells(Rows.Count, 1).End(xlUp).Row"  '登録文(改行も入れられます)
Case 2
 msg = "Set Rng =Range(""A1"", Cells(Rows.Count, 1).End(xlUp))"
Case 3
 msg = Format(Date, "yyyy/mm/dd (aaa)")
End Select
Call CopyBufFClip(msg)
End Sub

Private Sub CopyBufFClip(ByVal buf As String)
Dim hText As Long
Dim pText As Long
If OpenClipboard(ByVal 0&) Then
 hText = GlobalAlloc(&H42, LenB(buf) + 1)
 pText = GlobalLock(hText)
 If Not IsNull(pText) Then
  pText = lstrcpy(pText, buf)
  Call GlobalUnlock(hText)
  EmptyClipboard
  hText = SetClipboardData(1 Or 7, hText)
 End If
 CloseClipboard
End If
End Sub

'---------------
Application.InputBox("数字を入れてください。", "SetenceLists", Type:=2) 2は文字列
Case 1 ここを数字ではなく、文字にすることも可能です。
改行は、"文" & vbCrlLf & "文" で入ります。
---------------------
    • good
    • 1
この回答へのお礼

ご回答ありがとうございます。

>>Applicationオブジェクトをほとんど触ったことが無く、
>そんなことはないはずです。ふつう、標準モジュールの場合、親オブジェクトはは、Application オブジェクトですから、その表示は省略しても動くはずです。
その通りですね。"触る"という表現が間違っていました。普段はモジュールやブック以下しか意識せず、たまに.ScreenUpdatingなり.Waitを使う程度の知識レベル という意味です

>「ん」を最初につけると良いとか聞きましたが、そういう方法もありますね。
なるほど。「んあ」にFor系「んい」にWhile系 等と決めておけば、通常変換されない上に略語をしっかり覚えずとも欲しい定型文を選択できますね

>Wscript.Shell を使う方法があります。つまり、Wscript を利用します。VBAの外から命令するので、VBAからは直接影響を受けなくなります。
ありがとうございます。早速、貼って頂いたコードと共に試してみました。

Sub hoge() 'SelectSentencesの末尾で実行

 Dim WSH
 Set WSH = CreateObject("WScript.Shell")
 'メモ帳を開き、クリップボードの内容を張り付ける
 WSH.Run ("notepad.exe")
 Application.Wait Now() + TimeValue("00:00:01")
 WSH.SendKeys "^v"

End Sub

貧相なコードですみません。
Wscriptを軽く調べてみたところ膨大な量の情報が流れ込んできたので(有難いことです)こちらはじっくりと勉強させて頂こうと思います。

Windows側のクリップボードを利用するのは目から鱗でした。
特にCase 3 の「事前に整形した文字列をクリップボードにコピーする」ショートカットは、私の実務の一部の効率化に直結するものでした。
早速、組み込んで使ってみようと思います。

私が考えもしなかった手法や関数の数々を教えて頂き本当にありがとうございます...
まだまだ勉強が必要ですが、現時点でかなりの効率化が図れる実感があります。
度々の親切なご回答、あらためてありがとうございました!

お礼日時:2019/03/17 17:38

こんばんは。



>せめて既存ショートカットキーの割り当て変更ぐらいはしたいものです
>(Ctrl+Yの行削除に何度苦しめられたことか)

この程度は、OnKeyメソッドで登録すればよいです。
個人用マクロブックに登録すれば、マクロブックでなくても可能です。

Private Sub Workbook_Activate()
   Application.OnKey "^y", "MyMacro"   '^ は、コントロール+y
End Sub

後は、VBA Editor 上で動く、COM アドインになってしまうので、業務上許されないなら、どうしようもないですね。経験はあるのですが、USBメモリも許されるわけではありませんからね。

持ち込みできないときは、ある程度の期間、在籍できるなら、通常出てこない単語で、IME に登録します。ユーザー辞書に登録するので、本体に影響を与えるわけではありません。そうでなければ、やはりメモ帳でテキストファイルにするか、暗記するかどちらかになりますね。(暗記しても、私の場合、しばらく使っていないと忘れます)
    • good
    • 1
この回答へのお礼

再度のご回答ありがとうございます。
"業務上導入できない"ことから、いくつも代案を挙げて頂きたいへん感謝しております


Applicationオブジェクトをほとんど触ったことが無く、試しに作ってみたのですがExcel上でしか適用されませんでした。
''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Mymacro()
 Application.Undo
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''
VBA Editor上で動作する、Application.Undoに該当するものがあるのでしょうか?


IME登録は完全に盲点でした。
単語 "For i = 2 to Cells(Rows.Count,1).End(xlUp).Row"
よみ "ふぉいえ" (For i Endの略)

試しに上記を登録して使ってみた所、直観的に素早く入力できました
入力に慣れたら、メモ帳からのコピペより断然早くなりそうです
改行込みの単語登録には“オープン拡張辞書”なるものが必要らしいので、別途調べてみようと思います(恐らく私の環境では無理そうですが)
.tsv形式で一括登録できるのも、Excel上で整理出来てとても良いですね

お礼日時:2019/03/16 22:00

市役所などの自治体が行っているパソコン相談で相談したほうが良いと思います。

    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
Excelの基本動作等の相談には乗ってくれるとは思いますが、表題の件は無理かと思われます(特別詳しい方がいれば別ですが...)

お礼日時:2019/03/16 10:10

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

Q「-2147012889」というエラーでマクロが止まる

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).End(xlUp).Row
 Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
 If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub
 If getLine < Lastrow And Cells(1, 2).Value <> "" Then
  getLine = getLine + 1
 Else
  getLine = 1 '最初の行が1行目からの場合
 End If
 For i = getLine To Lastrow
  strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL
  strURL = Replace(strURL, "https:", "http:")
  If strURL Like "http*" Then
   objHttp.Open "GET", strURL, False
   objHttp.Send
   DoEvents 'ESC割り込み可能にする
   With objHttp
    If .Status = 200 Then
     nURL = .Option(1) 'WinHttpRequestOption_URL
     f = Mid(strURL, 1, InStr(strURL, "://"))
     l = Mid(nURL, 1, InStr(nURL, "://"))
     If nURL = "" Then
      Cells(i, 2).Value = "no URL"
     ElseIf nURL <> "" Then
      If LCase(f) = LCase(l) Then
       Cells(i, 2).Value = "non SSL"
      Else
       Cells(i, 2).Value = "https"
      End If
     End If
    Else
     Cells(i, 2).Value = "Err:" & .Status
    End If
   End With
  End If
Endline:
  nURL = ""
  strURL = ""
 Next i
 MsgBox "Finished"
 Exit Sub
ErrHandler:
 If Err() <> 0 Then
  Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー
  GoTo Endline
 End If
End Sub

順調に動いていたのですが、頻繁にエラーで止まるようになってきました。
エラーの時にはセルに、「-2147012889」という数値が記入されます。

この「-2147012889」を避けて、
エラーが出さずに、マクロを動かすことは可能でしょうか?

どのような記述で、避けることができるのでしょうか?
よろしくお願いいたします。

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).En...続きを読む

Aベストアンサー

No.1の回答者です。
「-2147012889」の数字が、本日、WiFiのエラーで出てきて考えたのですが、回線そのものの切断のようですね。一旦、エラーが出てくると、繰り返しなのか、復旧するまでにしばらく時間が掛かってしまいます。回線そのものを、有線LANにしたらと考えましたが、それは可能でしょうか。

今の所、IEオブジェクトを使ってやる方法を考えてはいるのですが、エラーでも、内部で済むのではないかと思います。しかし、いかんせん、ものすごく遅いのです。それにコードがややこしい上に、できるという保証はありません。他の良い手立てを思いつかないのです。ただ、Excel 2016ですと、まだ残されている方法があるかもしれません。

QCODE関数から他の文字コードの求め方

セル A1 に1文字が入力されているとき、私は今まで JIS、SJISコードを次式で求めてきました。間違い、あるいは、より簡便な方法があればご指摘ください。

JISコード B1: =DEC2HEX(CODE(A1),4)
SJISコード C1: =DEC2HEX(IF(ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112<=159,ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112,ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112+64))&DEC2HEX(IF(MOD(HEX2DEC(LEFT(B1,2)),2),IF(HEX2DEC(RIGHT(B1,2))+32>=127,HEX2DEC(RIGHT(B1,2))+32,HEX2DEC(RIGHT(B1,2))+32-1),HEX2DEC(RIGHT(B1,2))+126))

それから、上記の関数を利用して、あるいは、他の方法でも、UNICODE を求める数式を教えてください。
ついでながら、区点コードを求める方法はありますでしょうか?

セル A1 に1文字が入力されているとき、私は今まで JIS、SJISコードを次式で求めてきました。間違い、あるいは、より簡便な方法があればご指摘ください。

JISコード B1: =DEC2HEX(CODE(A1),4)
SJISコード C1: =DEC2HEX(IF(ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112<=159,ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112,ROUNDUP(HEX2DEC(LEFT(B1,2))/2,0)+112+64))&DEC2HEX(IF(MOD(HEX2DEC(LEFT(B1,2)),2),IF(HEX2DEC(RIGHT(B1,2))+32>=127,HEX2DEC(RIGHT(B1,2))+32,HEX2DEC(RIGHT(B1,2))+32-1),HEX2DEC(RIGHT(B1,2))+12...続きを読む

Aベストアンサー

Shift JISコードとは、JISコードをずらす(シフトする)ことで実現しているコードです。
そのため、その法則に従って計算することで JIS←→Shift JIS の変換ができます。

UNICODEは、JISとは違った文字の並び順になっています。
そのため、対応表を使った変換となります。

JISを使った CODE / CHAR に対応した
UNICODE盤の UNICODE / UNICHAR があります。
ただし、古いExcelにはありません
https://support.office.com/ja-jp/article/unicode-%E9%96%A2%E6%95%B0-adb74aaa-a2a5-4dde-aff6-966e4e81f16f



> ついでながら、区点コードを求める方法はありますでしょうか?

「JIS 区点 Excel」で検索してみましょう。

Q20万を 超える、連番の 生成。

お世話になります。


「,」や、「;」で、
区切られた、
定数配列や、配列数式上の、
等差連番数値を 20万個以上、

VBAを 使わず、
生成したいのですが、

何か 良い方法は、
ありますでしょうか?


宜しく お願いします。

Aベストアンサー

こんにちは

シートやセルは利用しても良いものと解釈しました。
ひとまず、20万行を超えられる、行数の方を利用する方法で考えてみました。

まず、必要となる等差数列をROW()に基づいた式として表します。
(例えば、 =ROW()*2-1 1,3,5…の等差数列)
この式をコピーしておいて、シートのA列全体を選択した状態で、ペーストします。
この結果、A1、A2…に1、3、5…と最終行まで表示されます。

単純な式でできないような内容でも、A列を利用してさらに関数式で値を作成することも可能でしょう。
例えば、B1セルに =A1*2 として、セルの右下をダブルクリックすれば最終行まで式がコピーされます。


配列数式等で利用する場合には、A:Aあるいは必要な範囲を切り取って参照することで、そのまま多行1列の配列として利用できると思います。
1行多列の場合も同じ方法で作成可能ではありますが、エクセルのシートは2万列もないため、残念ながら20万には程遠い数にしかなりません。

試してはいませんが、前記の多行1列の配列をTRANSPOSEで行・列の反転をさせることで、1行多列のお求めの内容にも変換することができるものと考えます。


※ そもそも20万超の要素の配列数式を、エクセルがどのくらいで計算できるのかに不安を感じますが・・・

こんにちは

シートやセルは利用しても良いものと解釈しました。
ひとまず、20万行を超えられる、行数の方を利用する方法で考えてみました。

まず、必要となる等差数列をROW()に基づいた式として表します。
(例えば、 =ROW()*2-1 1,3,5…の等差数列)
この式をコピーしておいて、シートのA列全体を選択した状態で、ペーストします。
この結果、A1、A2…に1、3、5…と最終行まで表示されます。

単純な式でできないような内容でも、A列を利用してさらに関数式で値を作成することも可能でしょう。
例えば、B1セル...続きを読む

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

QVBAでオブジェクトの名前に変数を用いる

Dim rng As Range, txtbox As Shape

Set rng = Range("A1")
Set txtbox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 100, 30)
text.Name = rng + "d"

この場合最後の行で変数 rng は無視されてテキストボックスの名前は「d」となります。

text.Name = Range("A1") + "d"
とか
text.Name = Cells(1,1) + "d"
とすると
名前は「(A1の内容)d」
となります。

この違いってどういうものなのでしょう。Range型変数を用いて「(A1の内容)d」とすることはできないのでしょうか。


もう1点だけ。
変数の型について
https://www.moug.net/tech/exvba/0150065.html
にあるObject型というのは
あらゆる種類のオブジェクトを格納できる、オブジェクトに関してはVariant的な存在なのでしょうか。

Dim rng As Range, txtbox As Shape

Set rng = Range("A1")
Set txtbox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 100, 30)
text.Name = rng + "d"

この場合最後の行で変数 rng は無視されてテキストボックスの名前は「d」となります。

text.Name = Range("A1") + "d"
とか
text.Name = Cells(1,1) + "d"
とすると
名前は「(A1の内容)d」
となります。

この違いってどういうものなのでしょう。Range型変数を用いて「(A1の内容)d」とすることはできないのでしょう...続きを読む

Aベストアンサー

No2です。

>A2とrngは参照という点で等価な気がしますが、難しい。
一方はオブジェクト、他方はセル位置を示す文字情報ですので、等価ではありません。
「Rangeはオブジェクトである」ということを忘れないでください。


>text.DrawingObject.Formula = "=rng" は動作せず
>text.DrawingObject.Formula = "=" & rng これは動作せず
>text.DrawingObject.Formula = rng ついでにこれも動作せず

いずれも関数式を設定するセンテンスで、右辺は関数式を意味する「文字列」である必要があります。
上記のうち、"=rng"は文字列ではありますが、そのまま "=rng"という意味になるので、関数式として理解されない可能性が高いです。
(エクセルはrngという名前の定義を探しますが、定義が見つからなければエラーになります)
その他は、オブジェクトを文字列であるかのように勘違いをしていると思われる記述になっていて、機械には解釈できない記述になっています。

なさりたいことは、Rangeオブジェクトが有しているセル位置の情報を文字列化した「A2」($A$2)を右辺に設定することではないでしょうか?
ですので、右辺を
 "=" & rng.Address
等とすることで、動作するようになると思います。
(rngオブジェクトが保持しているセル位置属性を明示的に示している)

No2です。

>A2とrngは参照という点で等価な気がしますが、難しい。
一方はオブジェクト、他方はセル位置を示す文字情報ですので、等価ではありません。
「Rangeはオブジェクトである」ということを忘れないでください。


>text.DrawingObject.Formula = "=rng" は動作せず
>text.DrawingObject.Formula = "=" & rng これは動作せず
>text.DrawingObject.Formula = rng ついでにこれも動作せず

いずれも関数式を設定するセンテンスで、右辺は関数式を意味する「文字列」である必要があります。
上記のう...続きを読む

QCSVで文字化けしてしまうのを直すマクロ

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例 空白→""、 神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With

’別のマクロ実行

End if
Next i1

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/fil...続きを読む

Aベストアンサー

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでし...続きを読む

Qエクセルのデータ抽出方法を教えてください

下記のような表から、A列のコードをもとにして「D」列の「3」行目の100、200、300(ピンク色)のセルを参照したいのですが関数がわかりません。
別のシートに10000なら100、20000なら200と表示させたいです。
vlookupでは行が1行でないとできませんでした。

Aベストアンサー

以下でいかがですか。
H2 =INDEX(E2:E13,MATCH(G2,A2:A13,0)+1)

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む

Q保存先フォルダとファイル名について

いつもお世話になっております。
保存をかける際にダイアログボックスを出したく、
またシートA1には保存先、B1にはファイル名を指定しておきたいのですが
どのようにすればよろしいでしょうか?
色々調べたのですが解決できず、アドレスどうぞよろしくお願いします。

ちなみにEXCEL2013を使用しています。

Sub CsvExportWithQuotation()
 Dim FileName As Variant
 Dim Rng As Range
 Dim LastCell As Range
 Dim c As Range
 Dim i As Long
 Dim strLine As String, fname As String, fpath As String

fpath = cells(1,1).value
fname = cells(1,2).value
 FileName = Application.GetSaveAsFilename( fpath & "¥" & fname,fileFilter:="CSVt Files (*.csv), *.csv")

保存先は指定出来るのですが、ファイル名が表示されません。
何卒よろしくお願い致します。

いつもお世話になっております。
保存をかける際にダイアログボックスを出したく、
またシートA1には保存先、B1にはファイル名を指定しておきたいのですが
どのようにすればよろしいでしょうか?
色々調べたのですが解決できず、アドレスどうぞよろしくお願いします。

ちなみにEXCEL2013を使用しています。

Sub CsvExportWithQuotation()
 Dim FileName As Variant
 Dim Rng As Range
 Dim LastCell As Range
 Dim c As Range
 Dim i As Long
 Dim strLine As String, fname As String, fp...続きを読む

Aベストアンサー

No1です。

>セルではなく直接書いてみたのですが
>ファイル名はFALSE.csv と表示がされました。
ご提示の通りの式を与えれば、そうなります。

第一引数をファイル名と解釈して評価しようとしますので、
> InitialFilename = "保存先&ファイル名"
 1)まず式をそのまま評価すると False(論理値)となり
 2)要求されているのは文字列なので、変換した"FALSE"を値として採用
 3)拡張子「.csv」が付け加えられて
 4)ダイアログのファイル名欄に「FALSE.csv」と表示
という処理がなされているものと思います。

>セルに関数も入っていないのに謎です
セルの値を参照していないのであれば、セルの状態がどうであるかは関係ないはずです。
(関係したら、その方がおかしい)

QVBAにWingdingsの文字って

本日2度目の質問です。本当にすみません。

■の代わりに□にレ点がはいったWingdingsの文字を使いたいのですが、?になって認識しません
対応策はないものでしょうか。
皆様、ご教示下さい。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B1:B10")) Is Nothing Then Exit Sub
Cancel = True
If Target.Value = "□" Then
Target.Value = "■"
ElseIf Target.Value = "■" Then
Target.Value = "□"
End If
End Sub

Aベストアンサー

おしゃっていることは確認できました。(なぜ、No.1 のコードがおかしいのはわかりませんが、どこかで間違ったようです)「Wingding 2」側をお使いのようです。

□の種類そのものが違うようですね。

論より証拠で、添付画像のようになればよいのですね。
それなら、こんな方法があります。姑息な方法かもしれませんが……

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Cancel = True
 If Intersect(Target, Range("B1:B10")) Is Nothing Then Exit Sub
 With Target
  If .Value = "■" Then
   .Font.Name = "MS ゴシック"
   .Value = "□"
  ElseIf .Value = "□" Then
   .Font.Name = "Wingdings 2"
   .Value = "P"
  ElseIf .Value = "P" Then
   .Font.Name = "MS ゴシック"
   .Value = "■"
  Else 'それ以外の文字や空白の時
   .Font.Name = "MS ゴシック"
   .Value = "■"
  End If
 End With
End Sub

おしゃっていることは確認できました。(なぜ、No.1 のコードがおかしいのはわかりませんが、どこかで間違ったようです)「Wingding 2」側をお使いのようです。

□の種類そのものが違うようですね。

論より証拠で、添付画像のようになればよいのですね。
それなら、こんな方法があります。姑息な方法かもしれませんが……

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Cancel = True
 If Intersect(Target, Range("B1:B10")) Is Nothing Then Exit Sub
 With Target
 ...続きを読む


このカテゴリの人気Q&Aランキング