出産前後の痔にはご注意!

お世話になります。
excel vba でクラスモジュールを使って処理したいのですが、標準モジュールのクラスのSetのところで、エラー91オブジェクト変数またはwithブロックが設定されていませんのエラーが出て、インスタンスがうまくいかないです。
クラスを使って組むのは初めてなもので、詳しい方のご教示をお願いいたします。
以下コードです。

クラスモジュール
Option Explicit
Dim i As Long
Dim j As Long
Public sh1 As Worksheet

Sub Mycls()
Application.ScreenUpdating = False

i = 8
j = 9

Set sh1 = Worksheets(1)

For i = 8 To 400
Do Until sh1.Cells(i, "F") < sh1.Cells(7, j)
j = j + 1
If sh1.Cells(i, "F") = sh1.Cells(7, j) Then
sh1.Cells(i, j) = "★"
Exit Do
End If
Loop

j = 9

Do Until j = 132
j = j + 1
If sh1.Cells(i, j) = "☆" Then
sh1.Cells(i, j) = ""
Exit Do
End If
Loop

j = 9

Do Until sh1.Cells(i, "G") < sh1.Cells(7, j)
j = j + 1
If sh1.Cells(i, "G") = sh1.Cells(7, j) Then
sh1.Cells(i, j) = "☆"
Exit Do
End If
Loop

j = 9

Next i

End Sub

標準モジュール
Option Explicit
Sub Module1()
Dim ss As New Mycls
Dim sh1 As Worksheet

Set sh1 = Worksheets(1)
Set ss = New Mycls
Set ss = Nothing

End Sub

A 回答 (1件)

クラスモジュールのオブジェクト名を指定してください。


クラスモジュールを開く。
左側、クラスモジュールのプロパティ、オブジェクト名に「Mycls」を設定。

で、標準モジュールの方で、

Set ss = New Mycls
ss.Mycls
としてモジュールを呼び出します。

--
クラスメイトモジュール名が同じは紛らわしいので、特に意味無いなら止めた方が良いかも。
インスタンス作成と同時に、コンストラクタとして処理を行うのであれば、

Public Sub Class_Initialize()
 ~処理~
End Sub

の中で行って下さい。
「excel vba クラスモジュール 教」の回答画像1
    • good
    • 0
この回答へのお礼

neko_deuxさん
早速の回答、ありがとうございます。
うまくいきました。感謝します。

お礼日時:2017/08/02 21:06

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

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

QVBA IF文でORを使ったとき後ろの条件が実行されない

下記VBAは特定の行だけ取り出すために組んだマクロの一部ですが、
なぜか.Value Like "W*"の部分が実行されません、
ORの前と後ろを逆にするとやはり前だけしか実行されません。

どこが問題なのでしょうか?
また、"J*"か"W*"以外の行を削除するという文はどう書くのでしょうか?

よろしくお願いします。


For j = Range("A1").End(xlDown).Row To 2 Step -1
With Cells(j, "AB")

If Not .Value Like "J*" Or .Value Like "W*" Then
.EntireRow.Delete
End If

End With

Next j

Aベストアンサー

>If Not .Value Like "J*" Or .Value Like "W*" Then
["J*"か"W*"以外の行を削除する]

これは、排他的論理積の内容ですね。
英米人は、何の問題もなく答えられるけれども、日本人などは、どうしても戸惑ってしまいます。英語には、こういう表現がありますが、日本語には、そういう表現があっても、言葉には正確に表す論理がありません。もし、本格的なプログラミングをおやりになるなら、是非、学ばれたほうがよいです。ベン図を書いて試してみるとよいです。

["J*"*か*"W*"以外の行を削除する]
「か=or(和)」が否定になると「and(積)」に変わると覚えていればよいです。

If Not (UCase(.Value) Like "J*" Or Not UCase(.Value) Like "W*" Then
または
If Not UCase(.Value) Like "J*" And Not UCase(.Value) Like "W*" Then

このように演算子が変わります。

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

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

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

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

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

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

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

Aベストアンサー

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

Attribute VB_Name = "test1"

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としたのではうま...続きを読む

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【VBA】 for next 繰り返し処理の入れ子の処理速度について

こんにちわ
マクロを作成しております。
入れ子した繰り返し処理に躓いております、
もしよろしければ高速化のアドバイスをいただければと思います。


B2から下方向に値をいれております。
C1から横方向に同じ値をいれております。
B1-C1,B1-D1,B1-E1・・・最終まで
、というようにリーグ戦の総当たり結果表のような
結果を出力しようとしています。
値は数値で差分を整数で出すだけで、
重複した結果は不要ですので階段状に出力させています。

B列70行程で処理に40秒程かかってしまう状態です。
何か余計な処理や修正したほうがよさそうな箇所ははありますでしょうか?

excel2013
win8 メモリ4G

_______________
Sub test3()

Dim sh As Worksheet
Dim m As Long, i As Long, j As Long

Application.ScreenUpdating = False '非表示

Set sh = Worksheets("test")

m = sh.Cells(Rows.Count, "B").End(xlUp).Row

For i = 1 To m - 1
For j = i To m - 1

sh.Cells(j + 1, i + 2) = _
Application.WorksheetFunction.RoundDown( _
Abs(sh.Cells(1, 2).Offset(i, 0).Value - sh.Cells(1, 2).Offset(0, j).Value), 0)
      ’小数点切り捨てなど入れてます。
      ’単純にi+jにしても処理時間は変わりませんでした。
Next j
Next i


End Sub
_______________

以上です、よろしくお願いします。

こんにちわ
マクロを作成しております。
入れ子した繰り返し処理に躓いております、
もしよろしければ高速化のアドバイスをいただければと思います。


B2から下方向に値をいれております。
C1から横方向に同じ値をいれております。
B1-C1,B1-D1,B1-E1・・・最終まで
、というようにリーグ戦の総当たり結果表のような
結果を出力しようとしています。
値は数値で差分を整数で出すだけで、
重複した結果は不要ですので階段状に出力させています。

B列70行程で処理に40秒程かかってしまう状態です。
...続きを読む

Aベストアンサー

コードをそのままで、B列200行程度実行しても一瞬で終わります。

コードの問題では無いですね。
PC環境かエクセルの問題だと思います。

そもそも、そのエクセルに直接文字入力した場合、入力の度に待たされる事は有りませんか?

QVBAでのファイル名と更新日(作成日)の抽出

VBAにてあるフォルダにあるすべてのPDFファイル名と更新日(作成日)の抽出をしたいです。
A1セルに抽出するフォルダパス名が入っています。

A3セルより下(A3,A4,A5~)にファイル名
B3セルより下(B3,B4,B5~)に更新日(作成日)

を表示させたいです。

ご教示願います。

Aベストアンサー

こんばんは。
本日、共有フォルダ(一部無線LANでの中継アリ)でいくつかテストしたのですが直接セルに取得した値を入力していくとかなり遅くなるようですね。

そこで、自分のPCのCドライブ直下に作業用のテキストファイルをつくり、そこにフォルダ内のファイルと更新日時をフィルタリングせずにずらっと書き込み。
それをExcelで、不要ファイルは無視しつつセルに入力していく、、という手法にしてみました。

ここでいう不要ファイルはMacから共有フォルダに書き込んだ際に出来ることがある、”.”で始まる隠しファイルの事です。

ちなみに、820個のファイルがある共有フォルダで、ワークテキスト作成が約20秒、それをExcelのセルに入力するのが「ほんの一瞬」です。
ファイルのなら並びはおそらくファイル名の昇順となっているようですが、そういったソート方法の変更もExcelに読み込んだのちに処理したほうが良いと思います。
ソート範囲の指定は、コードにもありますが、Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))というようなレコード数によって可変となるようにすれば大丈夫だと思います。

作業用テキストファイルは、該当するファイルが無い場合は新規で作りますし、既存の場合は、前回分はクリアされたうえで書き込まれます。
ファイルの設定場所は自分のPC上で権限ある場所ならどこでも構いません。

また、タブ区切りのテキストしているので、作業用テキストファイルを開いて全選択してコピー、A3セルをクリックした状態でペーストしても(不要ファイル除去を除いては)同じ結果が得られます。

ギリギリ現実な速度かなと思いますが、一度試されてみてください。


----以下 ソース---


Sub Pdflistup()

FolderPath = Range("A1").Value: 'セルA1にフォルダーのパスがあるということなので。
WText = "C:\WorkText.txt": '作業用テキストファイル

'該当フォルダにあるファイルの名称と更新日時を作業用テキストファイルに書き込む

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set FileObj = FileSys.GetFolder(FolderPath).Files
Set WorkText = FileSys.CreateTextFile(WText, True)

For Each PdfObj In FileObj

With PdfObj

WorkText.WriteLine (.Name & Chr(9) & .DateLastModified): '名称(タブ)更新日時の形で書き込み

End With

Next

WorkText.Close

Set FileSys = Nothing

'作業用テキストファイル作成処理完了


'セルの値をクリア(A3~Bの最終行まで)

Range("A3", Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).Clear


'WorkText.txtを開き、一行ずつセルに入力(ファイル名はA3から、更新日時はB3から)

Open WText For Input As #1

n = 3: '入力開始行

Do Until EOF(1)

Line Input #1, Tline

Tvalue = Split(Tline, Chr(9)): 'テキストをタブで分割(一次配列格納)

If Not Left(Tvalue(0), 1) = "." Then

Cells(n, 1).Value = Tvalue(0): 'n行A列にファイル名を入力
Cells(n, 2).Value = Tvalue(1): 'n行B列に更新日を入力
n = n + 1
End If
Loop

Close #1


'セル書き込み作業完了

MsgBox ("処理が完了しました。")


End Sub

こんばんは。
本日、共有フォルダ(一部無線LANでの中継アリ)でいくつかテストしたのですが直接セルに取得した値を入力していくとかなり遅くなるようですね。

そこで、自分のPCのCドライブ直下に作業用のテキストファイルをつくり、そこにフォルダ内のファイルと更新日時をフィルタリングせずにずらっと書き込み。
それをExcelで、不要ファイルは無視しつつセルに入力していく、、という手法にしてみました。

ここでいう不要ファイルはMacから共有フォルダに書き込んだ際に出来ることがある、”.”で始まる隠しフ...続きを読む

QVBAで指定シート以外の選択

お世話になっております。
VBAで指定セル以外を選択したいのですがどの様にプログラムを
構成すればよろしいのでしょうか?
全てのシートを選択のプログラムは「Worksheets.Select」ですが
例えばsheet1、sheet2、「勤務表」以外のシートを選択状態にしたいのです。
ご教示をお願い致します。

Aベストアンサー

こんな感じで。

Sub Sample()
  Dim ShName As String
  Dim i As Long
  Dim ara As Variant

  For i = 1 To Sheets.Count
    Select Case Sheets(i).Name
      Case "Sheet1", "Sheet2", "勤務表"
      Case Else
        ShName = ShName & "*" & Sheets(i).Name
    End Select
  Next
  ShName = Mid(ShName, 2)

  If ShName <> "" Then
    ara = Split(ShName, "*")
    Sheets(ara).Select
  Else
    MsgBox "選択できません"
  End If
End Sub

QVBA 3文字ずつ、配列に入れたい

お世話になります。

dim atai as variant
atai="1234567890"
という文字列があります。

これを

hairetu[0]=123
hairetu[1]=456
hairetu[2]=789
hairetu[3]=0

という風に、3文字単位で配列に格納したいのですが、どのように
VBAを作成すればよいでしょうか?

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

Aベストアンサー

例えば、

Dim atai As Variant
Dim hairetu() As Variant
Dim hairetu_size, iIndex As Integer ' 配列のサイズ, インデックス

atai = "1234567890"
' 配列のサイズを、ataiの文字数÷3 + 1で計算
hairetu_size = Int(Len(atai) / 3 + 1)
' 配列の大きさを再設定
ReDim hairetu(hairetu_size)
' 0番から配列サイズ-1までループ
For iIndex = 0 To hairetu_size - 1
  ' 3文字ずつ抜き出し
  hairetu(iIndex) = Mid(atai, 1 + iIndex * 3, 3)
Next iIndex

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メソッド は、常連さんの某氏の専売特許の...続きを読む

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
で取得できます。


人気Q&Aランキング