質問投稿でgooポイントが当たるキャンペーン実施中!!>>

今画像のようなAからC列をそのままシート2に移し、なおかつC列の中の日本語のみ日本語があったセルの日本語のみ右隣のセルに移すと言うマクロを組んでいたのですが、

Sub 言語判別()
Dim 実行結果 As Object
Dim 判別 As Range

Worksheets("Sheet2").Cells.Clear


Set 実行結果= Worksheets("sheet2")
Worksheets("sheet1").Columns("A:C").Copy Destination:=実行結果.Columns
("A:C")


Set 実行結果 = CreateObject("VBScript.Regexp")
実行結果.Pattern = "[一-龠ぁ-んァ-ンァ-ンパピプペポ]+"

For Each 判別 In Range("C2:C65536")

If 実行結果.test(判別.Value) Then 判別.Offset(, 1).Value =
実行結果.Execute(判別.Value)(0)

Next

Set 実行結果 = Nothing


MsgBox "判別終了しました。", vbInformation, cnsTITLE

End Sub

でやって見たのですがただコピーされるだけで上手くいきません。
シート2に移さずシート1で実行した場合は上手くいきました。
なぜシート2に移したら上手くいかなくなるのかわかりません。
教えてください。

「エクセル マクロについて」の質問画像

A 回答 (1件)

プログラム内で複数のシートを扱う場合、CellsやRangeはどのシートのものかを指定する必要があります。

省略した場合には、アクティブなシートに対して処理が行われます。

 ※なのでコピー後にSheet2をアクティブにするという方法もありますが、
  ちゃんとシートを指定したほうが良いと思います。

あとワークシートと正規表現を同じ変数で使いまわしていますが、ワークシートの方はWorksheet型の変数を使用した方が良いと思います。


Dim 実行結果シート As Worksheet

Set 実行結果シート = Worksheets("sheet2")
実行結果シート.Cells.Clear
Worksheets("sheet1").Columns("A:C").Copy Destination:=実行結果シート.Columns("A:C")

For Each 判別 In 実行結果シート.Range("C2:C65536") ' ←どのシートのRangeかを明確に指定する
    • good
    • 1
この回答へのお礼

ありがとうございます!!

再度試してみます!!

お礼日時:2017/08/08 11:41

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

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

QVBA、マクロについて、どなたか知恵をお貸し願います!

VBA独学中の初心者です。
ある問題に躓いており、どうしても動かない部分があるため、皆様のお力添えをいただきたいです。
説明が稚拙で分かりづらいかもしれませんが、宜しくお願いいたします。

① 2つのbook(book1/book2)があるとし、登録したマクロはbook2に設置する。
book2のsheet2に以下のような表を作る。
 ※枠線がズレてしまっていますが、それぞれが1つのセルと考えてください。
  人物・情報と入力されたセルは見出しです。
  また、1人の人物のデータに対し、その人の情報が3つあるとします。
  
______________
|人物   |   情報   |
_______________

|B君 |  |  |  |
_______________
|C君   | | | |
_______________
|A君 | | | |
_______________


② book1のsheet3に、同じ表があるとする。ただし、情報のセルは記入されている。
 
________________
|人物   |   情報     |
_______________

|A君 |長男|中学生|14歳|
_______________
|B君   |次男|小学生|10歳|
_______________
|C君 |長男|高校生|16歳|
_______________

③book2に設置しているマクロを実行すると、book1/sheet3のデータを読み込み、book2/sheet2の該当する人物のデータに表示されるようにする。但し、①②をみてわかるように、人物の名前の順番は同じではない。



・・・というものです。
最初に作ったプログラムでは、以下のように考えました。

book1/sheet3のUsedRangeから”A君”という文字列を

Set A君1 = Cells.Find(what:="A君", lookat:=xlPart)
で探し、
Selection.Offset(Columnoffset:=1).Select
で1つとなりのセルをActiveにし、
そのActivecellを"A君情報1"という変数にし、Do loopを使ってbook1/sheet3の"情報"セルがが空白になるまで1つずつ右に移動/変数を設定し、その値をbook2/sheet2の該当セルに代入していく・・・・(book2/sheet2の表からも、同じ工程で"A君"を探し、隣のセルに変数を設定する)というものです。そして、C君までの情報を全て出力し終えるというプログラムを作りたいのです。

ちなみに、book2からbook1の呼び出しはできました。

以下が作ってみたプログラムです。↓




'型があっていないとエラーになるため、とりあえずすべてVariant型にしています
Dim SorceFile As Variant, OpenFile As Variant
Dim A君1 As Variant, B君1 As Variant, C君1 As Variant
Dim A君情報1 As Variant, B君情報1 As Variant, C君情報1 As Variant
Dim A君情報2 As Variant, B君情報2 As Variant, C君情報2 As Variant

'現在開いているbook2の名前をSorceFileという変数にする
Set SorceFile = ThisWorkbook
'ファイル(book1)を選択して開く
OpenFile = Application.GetOpenFilename
If OpenFile <> fales Then
Filename = Dir(OpenFile)
MsgBox Filename
Workbooks.Open OpenFile
Else
MsgBox "キャンセルされました"
End If

'開いたファイル(book1)から、"A君"という文字列を探す。見つかったら、1つ隣のセルに移動し、"A君情報1"という変数を設定する。
ActiveSheet.UsedRange.Select
Set A君1 = Cells.Find(what:="A君", lookat:=xlPart)
A君1.Select
A君1.Offset(columnoffset:=1).Select
A君情報1 = ActiveCell

'マクロが設置されているbook2をアクティブにし、同様に"A君"という文字列を探す。見つかったら、1つ隣のセル(空白)に移動し、その空白のセルに"A君情報2"という変数を設定する。
ThisWorkbook.Activate
ActiveSheet.UsedRange.Select
Set A君2 = Cells.Find(what:="A君", lookat:=xlPart)
A君2.Select
A君2.Offset(columnoffset:=1).Select
A君情報2 = ActiveCell




・・・と、ここまではステップインをしながら変数の値を確認できています。、
このあとbook2の空白のセル"A君情報2"にbook1の"A君情報1"の値を代入したいのですが、

ThisWorkbook.Worksheets("sheet2").A君情報2.value = Workbooks(SorceFile).Worksheet("sheet1").A君情報1.value

↑ではコンパイルエラーになります。book2の表、A君の空白の情報で"長男"~"14歳"まで、book1から抽出/出力ができたら、次はB君C君・・・としていきたいのですが、「型が一致しない」や「インデックスが有効範囲にありません」となってしまいます。
この値だけ代入することができれば、私の力でもプログラムを最後まで作成することができるのですが・・・

分かりづらく、しかも玄人の方からすれば何だこのマクロは!!となるかもしれませんが、
どうかアドバイスの程、宜しくお願いいたします。

VBA独学中の初心者です。
ある問題に躓いており、どうしても動かない部分があるため、皆様のお力添えをいただきたいです。
説明が稚拙で分かりづらいかもしれませんが、宜しくお願いいたします。

① 2つのbook(book1/book2)があるとし、登録したマクロはbook2に設置する。
book2のsheet2に以下のような表を作る。
 ※枠線がズレてしまっていますが、それぞれが1つのセルと考えてください。
  人物・情報と入力されたセルは見出しです。
  また、1人の人物のデータに対し、その人の情報が3つあると...続きを読む

Aベストアンサー

こんばんは。

要するに、ソースファイル(データファイル)から情報を取り出す内容なのですね。
それをあえてFind メソッド指定なのかな?

>ActiveSheet.UsedRange.Select
だったら、以下は、Cells ではなくて、Selection でしょうね。

> Cells.Find(what:="A君", lookat:=xlPart)
なぜ、xlPart になっているのでしょうか?表記の乱れがあるということでしょうか?
変数の使い方とか、初歩的なところがまだ出来ていません。

>玄人の方からすれば何だこのマクロは
Findメソッド は、常連さんの某氏の専売特許のようなものですが、私だと、配列からMatch関数を利用しいるのだろうとは思います。玄人的なら、ADODBでしょう。ファイルを直接開けないで可能だからです。もちろん、Excel関数での処理もありますが、あまり格好がよくありません。

私が書くと、こんなコードにしてしまいます。

person info1 info2 info3
A君 長男 中学生 14歳
B君 次男 小学生 10歳
C君 長男 高校生 16歳
D君 三男 大学生 18歳 * 新たな情報が加わった場合も、D君のものだけを取るようにしています。

一旦取得した後に、D君の資料を取り寄せる
B君 次男 小学生 10歳
C君 長男 高校生 16歳
A君 長男 中学生 14歳 
D君 



'//標準モジュール
Sub GetDataAll()
 Dim wb1 As Workbook 'データのソースファイル
 Dim AcSh As Worksheet 'アクティブシート(データを受け取る側)
 Dim c As Range
 Dim r As Range
 Dim startRw As Long '検索文字列の最初の行
 Dim FindArea As Range 'データ・ソースの被検索場所
 Const FNAME As String = "myDATABook.xlsx" 'Thisbook と同フォルダーのファイル名
 Set AcSh = ThisWorkbook.Worksheets("Sheet2")
 
 On Error GoTo ErrHandler
 Set wb1 = Workbooks(FNAME) 'オブジェクトとして認識できるか?できなければ、ErrHandlerに飛ぶ
 
 Set FindArea = wb1.Worksheets("Sheet1").Columns(1) 'ソースファイルの1列目を検索
 With AcSh
  Application.Goto AcSh.Range("A1") 'データをインポートするシートに戻る

  'データに空きがないか調べ、データ検索の初期値の行を求める
  If .Cells(Rows.Count, 1).End(xlUp).Row > .Cells(Rows.Count, _
    2).End(xlUp).Row Then
    startRw = .Cells(Rows.Count, 2).End(xlUp).Row + 1
  Else
    MsgBox "データの取得の必要がありません。", vbExclamation
    Exit Sub
  End If
  
  '単語検索は、ワイルドカードを加える, c.Value & "*" ->LookAt:=xlWhole となる
  For Each c In .Range(.Cells(startRw, 1), .Cells(Rows.Count, 1).End(xlUp))
   If c.Value <> "" Then
    Set r = FindArea.Find(What:=c.Value & "*", LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
      MatchByte:=False)
    If Not r Is Nothing Then
     '配列の受け渡し(非推奨)
     c.Offset(, 1).Resize(, 3).Value = r.Offset(, 1).Resize(, 3).Value
    End If
   End If
  Next
 End With
 Exit Sub
ErrHandler:
 'エラーの発生の場合
 If Err.Number = 9 Then
  If Dir(FNAME) <> "" Then
   Workbooks.Open FNAME
   Resume 'エラーを発生した所まで戻る
  Else
   MsgBox "ファイルが見つからないか、パスを指定してください。", vbExclamation
   Exit Sub
  End If
 Else
  MsgBox Err.Number & " :" & Err.Description & " :" & Erl
 End If
End Sub

'//

 '配列の受け渡し
 c.Offset(, 1).Resize(, 3).Value = r.Offset(, 1).Resize(, 3).Value

入門・初級レベルでは、Copy メソッドのほうが良いでしょう。
r.Offset(, 1).Resize(, 3).Copy c.Offset(, 1)

こんばんは。

要するに、ソースファイル(データファイル)から情報を取り出す内容なのですね。
それをあえてFind メソッド指定なのかな?

>ActiveSheet.UsedRange.Select
だったら、以下は、Cells ではなくて、Selection でしょうね。

> Cells.Find(what:="A君", lookat:=xlPart)
なぜ、xlPart になっているのでしょうか?表記の乱れがあるということでしょうか?
変数の使い方とか、初歩的なところがまだ出来ていません。

>玄人の方からすれば何だこのマクロは
Findメソッド は、常連さんの某氏の専売特許の...続きを読む

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む

Qvba 標準モジュールインポート時のモジュール名を module1 以外にしたい

Excel vba で標準モジュールをインポートしたいのですが、ファイル名がすべて
module1,module2になります。

①ThisWorkbook.VBProject.VBComponents.Import "C:\test1.bas"

②vbaエディタで ファイルのインポート

①②どちらの方法でも 標準モジュール名が module1 になります。
この場合、test1 の名前でインポートされたいです。

インポートしたファイル名が標準モジュール名になるにはどうすればよいでしょうか。

どうぞアドバイスをお願いいたします。

Aベストアンサー

出力された bas ファイルの中の以下の部分を書き換え、"test1" にすればよいと思います。

Attribute VB_Name = "test1"

QExcel VBAについて

Excel VBAについての質問です。

現在UserForm1とUserForm2の二つを用意しておりUserForm1にはコマンドボタンが10個、
UserForm2にはリストボックスが一個配置されています。

やりたいことは…
UserForm1のコマンドボタンを押しそのコマンドボタン名をEXCELのSheet1からFind関数を使用して検索し、
その検索結果の列をUserForm2のリストボックスに表示させるといったものを作成していますが
どうしてもコマンドボタンの名前(Caption)を取得することが出来ません。

どのように取得したらよいのでしょうか?

検索イメージは
.Range("A1:V1").Find("CommandButton.name").Column
こんな感じでしょうか?


よろしくお願い致します。

Aベストアンサー

コマンドボタンのオブジェクト名がCommandButton1なら
CommandButton1.Caption
で取得できます。

QVBA教えてください

以下のようにテキストファイルに記入されている文字列をエクセルに抽出したいのですが
なかなか思うようにいきません。

<テキストデータ>
項 A B C D
1 40
2 30
3 20

<エクセルに抽出したいデータ>
1 40
2 30
3 20


どなたかお詳しい方いらっしゃいましたら教えて頂けると幸いです。

Aベストアンサー

大変遅くなりました。以下のような感じはいかがでしょうか?
---------------------------------------------------------------------------------
Sub Sample()
Dim 対象ファイル As String
Dim 行データ As String
Dim 位置 As Long
Dim 対象位置 As Long
Dim 文字数 As Long
Dim 対象 As Boolean
Dim 行 As Long
Dim 比較文字 As String
Dim 数字 As String
対象ファイル = Application.GetOpenFilename("テキスト ファイル,*.txt")
If 対象ファイル = "False" Then Exit Sub
Open 対象ファイル For Input As #1
Do Until EOF(1)
Line Input #1, 行データ
If 対象 Then
If 対象位置 > Len(行データ) Then 対象 = False
If Mid(行データ, 1, 1) < "0" Then 対象 = False
If Mid(行データ, 1, 1) > "9" Then 対象 = False
If Mid(行データ, 対象位置, 1) < "0" Then 対象 = False
If Mid(行データ, 対象位置, 1) > "9" Then 対象 = False
Else
比較文字 = ""
For 位置 = 1 To Len(行データ)
If Mid(行データ, 位置, 1) <> " " Then
比較文字 = 比較文字 & Mid(行データ, 位置, 1)
If Mid(行データ, 位置, 1) = "D" Then 対象位置 = 位置
End If
Next
End If
If 対象 Then
行 = 行 + 1
数字 = ""
For 位置 = 1 To 対象位置
If Mid(行データ, 位置, 1) < "0" Then Exit For
If Mid(行データ, 位置, 1) > "9" Then Exit For
数字 = 数字 & Mid(行データ, 位置, 1)
Next
Cells(行, 1).Value = 数字
数字 = ""
For 位置 = 対象位置 To Len(行データ)
If Mid(行データ, 位置, 1) < "0" Then Exit For
If Mid(行データ, 位置, 1) > "9" Then Exit For
数字 = 数字 & Mid(行データ, 位置, 1)
Next
Cells(行, 2).Value = 数字
Else
If 比較文字 = "ABCD" Then 対象 = True
For 位置 = 1 To Len(行データ)
If Mid(行データ, 位置, 1) = "D" Then 対象位置 = 位置
Next
End If
Loop
Close #1
End Sub
---------------------------------------------------------------------------------

大変遅くなりました。以下のような感じはいかがでしょうか?
---------------------------------------------------------------------------------
Sub Sample()
Dim 対象ファイル As String
Dim 行データ As String
Dim 位置 As Long
Dim 対象位置 As Long
Dim 文字数 As Long
Dim 対象 As Boolean
Dim 行 As Long
Dim 比較文字 As String
Dim 数字 As String
対象ファイル = Application.GetOpenFilename("テキスト ファイル,*.txt")
If 対象ファイル = "False" Then Exit Sub
Open 対象ファイル For Inp...続きを読む

Q【エクセル】最終行までコピーするマクロ

マクロ初心者です。

下記のマクロを実行するためにはどうしたらいいでしょうか。
--------------------------
A B C D E F G
1 2 2 3 4 4 5
1 
1
1
1

▼▼▼▼▼▼▼▼▼▼▼▼
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
--------------------------
今躓いている現状
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  2 2 3 4 4 5
  ・ ・ ・ ・ ・ ・
  ・ ・ ・ ・ ・ ・
  ・ ・ ・ ・ ・ ・
--------------------------


行に関してはその時々によって変わります。
よろしくお願いいたします。

マクロ初心者です。

下記のマクロを実行するためにはどうしたらいいでしょうか。
--------------------------
A B C D E F G
1 2 2 3 4 4 5
1 
1
1
1

▼▼▼▼▼▼▼▼▼▼▼▼
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
--------------------------
今躓いている現状
A B C D E F G
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
1 2 2 3 4 4 5
  2 2 3 4 4 5
...続きを読む

Aベストアンサー

お礼を見て:

>ちなみにコレをB~Gでそれぞれ言葉を変えたいときはどこを変更すれば良いでしょうか?

全ては書いてませんけど。

Sub try()
Dim r As Range

Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))

' Offset(行,列)で書き込みたい所を決めます。
' 行に変更はないのでOffset(,列)と行を省略できます。
' ただし列毎に代入したい値が変わるので、列数分書かないと
' なりませんけどね

' 例えばB列の場合Offset(,1) A列から見て右に+1 となり

r.Offset(, 1).Value = "あああ"

' G列の場合 A列から見て右に+6 となり

r.Offset(, 6).Value = "かかか"

' と、Offsetの列数を変更する事で書き込みたい位置を変えます
' ちなみに0だと同じ列。-1だと左に変わっていきます。
' 今回はA列を基準にしてますのでマイナスはアウトですけど。
' 行はプラスが下方向、0は同じ行、マイナスは上方向です。

Set r = Nothing

End Sub

こんな感じになりますかね。

お礼を見て:

>ちなみにコレをB~Gでそれぞれ言葉を変えたいときはどこを変更すれば良いでしょうか?

全ては書いてませんけど。

Sub try()
Dim r As Range

Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))

' Offset(行,列)で書き込みたい所を決めます。
' 行に変更はないのでOffset(,列)と行を省略できます。
' ただし列毎に代入したい値が変わるので、列数分書かないと
' なりませんけどね

' 例えばB列の場合Offset(,1) A列から見て右に+1 となり

r.Offset(, 1).Value = "あああ"

' G列の場合...続きを読む

Q共有フォルダからのファイル名抽出(VBA)

以前、同様の質問をしたのですが、共有フォルダからファイル名+更新日の抽出する方法をご教示しただいたのですが、30分以上かかっても終わりませんでした・・・・(数が10000以上あるからかと思いますが。。。。)教えていただいたのに申し訳ありません。。。

改めて、更新日は不要にして、ある共有フォルダからファイル名をエクセルに出力する方法を教えていただけませんでしょうか?

B1セルには"ファイル名"というTITELが入っているので
B2セルより下(B2、B3、B4~)にファイル名を記載していくような構文です。
※Dir関数、もしくはそれより早い方法があれば、そちらでも構いません。

よろしくお願いします。

Aベストアンサー

No1です。先のファイルを自分のPCに保存
buf = Dir(ThisWorkbook.Path & "\*.xlsx")
の部分を
buf = Dir(”共有フォルダのパス” & "\*.xlsx")
に変更してみて下さい。

Qボタン一個で表示非表示切り替えマクロについて教えてください。 長文失礼します。マクロ初心者です。 ま

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 後期
7 空白 実績
ーーーーーーーーーーーーーーーーーーーーー

・ (★3行ずつ×10〜15コ分続く)
・ (★取引名がないとこは3行とも空白)
ーーーーーーーーーーーーーーーーーーー
20 小計 前期計
21 後期計
22 合計
23 実績計 (★小計欄は4行)
ーーーーーーーーーーーーーーーーーーーーーー
ここまでで1項目、(運用、保守などで区切っています)
次は保守の、同じのが。という風に1000行以上続きます。

別のファイルの取引no.と一致したら費目金額を反映させるマクロを取り込みボタンに設定中なので、
このフォーマットは変えられません。

そして、今回作成しなければならないのが、
表示非表示切り替えボタンです。
3行の一番上に取引名が入り、下2行は空白です。
一番上に取引名が入ってなかったら、以下の3行まとめて非表示/表示を切り替えたいんです。
現状、基本は1項目につき3行ずつ×10ですが
取引名が多数あるものはその分増やしているので統一はしていません。

また、各項目1つでも取引名があれば小計欄は非表示しない。
0だったら小計欄も非表示にする。
というルールです。


先方のお願いは
ボタン一個で、表示をクリックしたら表示され、ボタンの名前は非表示に変わり、非表示をクリックしたら非表示になり、名前は表示に、ということなのですが、


全然できてないのですが、
私が今考えていたコードは

If 切り替え.Caption = ”表示” Then
For i = 2 To LastRow Step 3
★まずここで、3行ずつ回すも、小計欄は4行なのでどうしたらいいのか
続き

If Cells(i,1) <> ”” And _
Cells(i,1) <> ”小計” Then
icnt = icnt + 1
EndIf
値があったらカウントし
後に、icnt>=1 Then
小計欄は残す、という流れをイメージしたのですが…


If Cells(i,1)= ”” Then
Rows(i).Hidden

If Cells(i,1) = ”小計” Then
If icnt>=1 Then
という流れにする場合、
もし残すなら、
次の項目からまたスタートとなるにはどうすればいいのか…
非表示の場合まとめて4行はアクティブセル+3という式にしたらいいのか、、
すみませんがもしよろしければコードをご教示ください。

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 ...続きを読む

Aベストアンサー

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうまくいかないと思います。

一例として、調べる対象の行(先頭行)を変数rwとして、順に見ていくものと考えた場合

 rw = 2 '←対象行の初期値
 Do While rw <= LastRow
  If Cells(rw, 1).Value = "小計" Then
   '小計の場合の処理
   ' ~~~
   rw = rw + 4 '←次の行(4でよいのか不明ですが)
  Else
   '3行セットの場合の処理
   ' ~~~
   rw = rw + 3 '←次の行
  End If
 Loop

のような考え方にすれば、対象の行数が異なる場合でも、条件分けして処理をすることで、次に参照する行までの行数を変えることが可能です。
上の例では、小計欄の4行の1行目には必ず「小計」と記されていて、それで識別しても良いとの保証があるものと仮定しています。(取引名には「小計」というものは絶対に存在しないなど)

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうま...続きを読む

Qvbsでは漢字の変数は使えないのでしょうか。

下記はエラーになります。
Option Explicit
Dim 氏名

氏名=InputBox("氏名を入力して下さい")
MsgBox(氏名)

ここで、氏名をnameに変更すると正しく実行します。
Option Explicit
Dim name

name=InputBox("氏名を入力して下さい")
MsgBox(name)

漢字の変数を使う方法は無いのでしょうか。

Aベストアンサー

もうお答えは出ているようですが、私からも回答します。

2byte 文字を変数にすると、

\kanjitest.vbs(2, 5)
「Microsoft VBScript コンパイル エラー: 文字が正しくありません。」

のエラーが出ます。
Unicode VBSにしても、やはりエラーが出ます。

もともと、String 型で認められる所以外では、2byte 文字は、ハングしますから、仕方がありません。VBAとは違いますから。
これを、HTA にして、Charset を、UTF-8 にしても、エラーは出ます。諦めることでしょうね。

Q【配列の練習中】変数(範囲)に格納した値を別シートの特定のセルに表示

VBAを練習中で、現在、配列について練習しております。
”要素”シートのセル範囲を配列に格納し、”出力”シートの特定セルに表示させたいです。
例示してある”要素”シートは数行ですが、この行が数百行有るような場合を想定しています。
変数(i)も変化させ、要素シートの中から特定(i)の行を格納し、出力に表示させたいです。
住所録(データシートが要素で、個々の情報を出力に呼び出す)みたいな感じを想定しています。

自分なりに調べながら書いたコード、シート情報を記載します。
よろしくお願いいたします。


Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim youso As Range
Dim i As Long

Set sh1 = Worksheets("要素")
Set sh2 = Worksheets("出力")

i = 2 '必要に応じてiの値を変える予定あり

Set youso = sh1.Range(Cells(i, 1), Cells(i, 5))

'↑ここでエラーが出ます。

With sh2
.Range("C2") = youso(1) '要素1
.Range("F2") = youso(2) '要素2
.Range("D4") = youso(3) '要素3
.Range("D6") = youso(4) '要素4
.Range("G5") = youso(5) '要素5
End With

End Sub

VBAを練習中で、現在、配列について練習しております。
”要素”シートのセル範囲を配列に格納し、”出力”シートの特定セルに表示させたいです。
例示してある”要素”シートは数行ですが、この行が数百行有るような場合を想定しています。
変数(i)も変化させ、要素シートの中から特定(i)の行を格納し、出力に表示させたいです。
住所録(データシートが要素で、個々の情報を出力に呼び出す)みたいな感じを想定しています。

自分なりに調べながら書いたコード、シート情報を記載します。
よろしくお願いい...続きを読む

Aベストアンサー

こんにちは。

そのコードですと、配列になっていないのです。
配列を、簡単な方式で書いてみました。すこし複雑になってしまいますね。

Sub 配列方式()
 Dim Sh1 As Worksheet
 Dim Sh2 As Worksheet
 Dim youso As Range
 Dim Ary_youso(4)  '配列変数
 Dim Rng As Range
 Dim i As Long, j As Long, c As Range
 Set Sh1 = Worksheets("要素")
 Set Sh2 = Worksheets("出力")
  i = 2 '行
 With Sh1
  Set youso = .Range(.Cells(i, 1), .Cells(i, 5))
  Next j
  For j = 0 To 4
   Ary_youso(j) = youso(j + 1).Value '配列変数に入れる
 End With
 j = 0
 With Sh2
 Set Rng = .Range("C2,F2,D4,D6,G5")
 For Each c In Rng
  c.Value = Ary_youso(j)  '配列変数からの吐き出し
  j = j + 1
 Next c
 End With
End Sub

こんにちは。

そのコードですと、配列になっていないのです。
配列を、簡単な方式で書いてみました。すこし複雑になってしまいますね。

Sub 配列方式()
 Dim Sh1 As Worksheet
 Dim Sh2 As Worksheet
 Dim youso As Range
 Dim Ary_youso(4)  '配列変数
 Dim Rng As Range
 Dim i As Long, j As Long, c As Range
 Set Sh1 = Worksheets("要素")
 Set Sh2 = Worksheets("出力")
  i = 2 '行
 With Sh1
  Set youso = .Range(.Cells(i, 1), .Cells(i, 5))
  Next j
  For j = 0 To 4
   Ar...続きを読む


人気Q&Aランキング