今会社でエクセルを作成しています。
使用しているエクセルは2003です。
Ctrl+Fの機能とオートフィルタの機能を足したものを作成しようとしています。
現在 入力している内容は下記になります。
Dim txt As String
Dim target As Range
Dim rng As Range
Dim adr As String
'Set target = Range("A6:L6 & Rows.Count) '
txt = InputBox("検索する内容を記述して下さい。")
If txt = "" Then Exit Sub
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
If rng Is Nothing Then
MsgBox "ありません"
Exit Sub
End If
adr = rng.Address
Do
rng.Activate
Set rng = Range("A6:L" & Rows.Count).FindNext(rng)
If rng.Address = adr Then MsgBox "終わりに達しました"
If MsgBox("続けて調べますか?", vbYesNo) = vbNo Then Exit Do
Loop
End Sub
項目はA6からL6までに記入されていきます。
一部内容は空白の部分もでますが、A6・B6は必須入力です。
下方向に内容が無限に増えて行きます。
現在エラーで
“オブジェクト変数または With ブロック変数が設定されていません”と出てしまっています。
Set rng = target.Find(txt, After:=target(target.Count), LookAt:=xlPart)
ここの部分がおかしいように思われます。
ですが、どう直せばいいのか分からず先に進めません…
皆様の知識をお借りできればと思い投稿致しました。
何卒宜しくお願い致します。
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
先日、
http://okwave.jp/qa/q8321600.html
で質問した内容なのですが、解決したと思ったらまだ未解決のため、再度質問いたします。
A列に住所のデータがあるのですが、形式がちょっと特殊で、
A1 千代田区千代田1-1-1-301千代田マンション１号棟
A2 千代田区千代田2-3-4
というな形になっています。(A1,A2はセル番地表示で、その文字列がセルにあるわけではありません)
並び順が、市名（区名）・町名・丁目・番地・号地・部屋番号・物件名となっています。
データの定義は、丁目・番地・号地・部屋番号については半角数字・市名（区名）・町名・物件名は数字やアルファベットを含むものであっても全角であることは担保されております。
戸建てであればいいのですが、集合住宅の場合、物件名と部屋番号が入れ替わってしまっています。
これを、できればA列には住所、B列には物件名・（全角スペース）・部屋番号とわけたいのです。
A B
1 千代田区千代田1-1-1 千代田マンション１号棟 301
2 千代田区千代田2-3-4
という内容で、ご回答いただいた
Sub SplitAddresses()
Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer, pos3 As Integer
For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
With Cells(i, "a")
For n = 0 To 9
pos1 = InStrRev(.Value, n)
If pos2 < pos1 Then pos2 = pos1
Next n
Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)
.Value = Left$(.Value, pos2)
pos2 = 0
pos3 = InStrRev(.Value, "-")
If pos3 And Cells(i, "b").Value <> "" Then
Cells(i, "b").Value = Cells(i, "b").Value & " " & Right$(.Value, Len(.Value) - pos3)
.Value = Left$(.Value, pos3 - 1)
End If
End With
Next i
Columns("a:b").AutoFit
End Sub
というコードでうまくいくと思ったのですが、
千代田区千代田1-2-3-4F千代田マンション１号棟
千代田区千代田1-1-1-A千代田マンション１号棟
といったデータも存在し、For n = 0 To 9ではまかなえないことがわかりました。
（数字の部屋番号だけではなく、4FやAなど、アルファベットの部屋番号が存在するということです）
数字だけではなく、半角英数字を末尾から検査し、その文字列がある位置を割り出す必要があるのですが、InStrRev関数とLike演算子を組み合わせて、返り値をpos1に代入しようと思ったもののうまくいきません。
ひとまず、返り値の確認のため、下記のようなコードを書きましたが、
Cells(1, 2) = InStrRev(Cells(1, 1), Like "*[0-z]*")
というコードは通らず、
Cells(1, 2) = InStrRev(Cells(1, 1), Cells(1, 1) Like "*[0-z]*")
というコードは返り値が0になってしまいます。
上記のような場合、どのようなコードが適していますでしょうか。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
先日、
http://okwave.jp/qa/q8321600.html
で質問した内容なのですが、解決したと思ったらまだ未解決のため、再度質問いたします。
A列に住所のデータがあるのですが、形式がちょっと特殊で、
A1 千代田区千代田1-1-1-301千代田マンション１号棟
A2 千代田区千代田2-3-4
というな形になっています。(A1,A2はセル番地表示で、その文字列がセルにあるわけではありません)
並び順が、市名（区名）・町名・丁目・番地・号地・部屋番号・物件名となっています。
データの定義は、丁目・番地・号地・部屋番号については半角数字・市名（区名）・町名・物件名は数字やアルファベットを含むものであっても全角であることは担保されております。
戸建てであればいいのですが、集合住宅の場合、物件名と部屋番号が入れ替わってしまっています。
これを、できればA列には住所、B列には物件名・（全角スペース）・部屋番号とわけたいのです。
A B
1 千代田区千代田1-1-1 千代田マンション１号棟 301
2 千代田区千代田2-3-4
という内容で、ご回答いただいた
Sub SplitAddresses()
Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer, pos3 As Integer
For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
With Cells(i, "a")
For n = 0 To 9
pos1 = InStrRev(.Value, n)
If pos2 < pos1 Then pos2 = pos1
Next n
Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)
.Value = Left$(.Value, pos2)
pos2 = 0
pos3 = InStrRev(.Value, "-")
If pos3 And Cells(i, "b").Value <> "" Then
Cells(i, "b").Value = Cells(i, "b").Value & " " & Right$(.Value, Len(.Value) - pos3)
.Value = Left$(.Value, pos3 - 1)
End If
End With
Next i
Columns("a:b").AutoFit
End Sub
というコードでうまくいくと思ったのですが、
千代田区千代田1-2-3-4F千代田マンション１号棟
千代田区千代田1-1-1-A千代田マンション１号棟
といったデータも存在し、For n = 0 To 9ではまかなえないことがわかりました。
（数字の部屋番号だけではなく、4FやAなど、アルファベットの部屋番号が存在するということです）
数字だけではなく、半角英数字を末尾から検査し、その文字列がある位置を割り出す必要があるのですが、InStrRev関数とLike演算子を組み合わせて、返り値をpos1に代入しようと思ったもののうまくいきません。
ひとまず、返り値の確認のため、下記のようなコードを書きましたが、
Cells(1, 2) = InStrRev(Cells(1, 1), Like "*[0-z]*")
というコードは通らず、
Cells(1, 2) = InStrRev(Cells(1, 1), Cells(1, 1) Like "*[0-z]*")
というコードは返り値が0になってしまいます。
上記のような場合、どのようなコードが適していますでしょうか。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
先日、
http://okwave.jp/qa/q8321600.html
で質問した内容なのですが、解決したと思ったらまだ未解決のため、再度質問いたします。
A列に住所のデータがあるのですが、形式がちょっと特殊で、
A1 千代田区千代田1-1-1-301千代田マンション１号棟
A2 千代田区千代田2-3-4
というな形になっています。(A1,A2はセル番地表示で、その文字列がセルにあるわけではありません)
並び順が、市名（区名）・町名・丁目・番地・号地・部屋番号・物件名となっています。
データの定義は、丁目・番地・号地・部屋番号については半角数字・市名（区名）・町名・物件名は数字やアルファベットを含むものであっても全角であることは担保されております。
戸建てであればいいのですが、集合住宅の場合、物件名と部屋番号が入れ替わってしまっています。
これを、できればA列には住所、B列には物件名・（全角スペース）・部屋番号とわけたいのです。
A B
1 千代田区千代田1-1-1 千代田マンション１号棟 301
2 千代田区千代田2-3-4
という内容で、ご回答いただいた
Sub SplitAddresses()
Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer, pos3 As Integer
For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row
With Cells(i, "a")
For n = 0 To 9
pos1 = InStrRev(.Value, n)
If pos2 < pos1 Then pos2 = pos1
Next n
Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)
.Value = Left$(.Value, pos2)
pos2 = 0
pos3 = InStrRev(.Value, "-")
If pos3 And Cells(i, "b").Value <> "" Then
Cells(i, "b").Value = Cells(i, "b").Value & " " & Right$(.Value, Len(.Value) - pos3)
.Value = Left$(.Value, pos3 - 1)
End If
End With
Next i
Columns("a:b").AutoFit
End Sub
というコードでうまくいくと思ったのですが、
千代田区千代田1-2-3-4F千代田マンション１号棟
千代田区千代田1-1-1-A千代田マンション１号棟
といったデータも存在し、For n = 0 To 9ではまかなえないことがわかりました。
（数字の部屋番号だけではなく、4FやAなど、アルファベットの部屋番号が存在するということです）
数字だけではなく、半角英数字を末尾から検査し、その文字列がある位置を割り出す必要があるのですが、InStrRev関数とLike演算子を組み合わせて、返り値をpos1に代入しようと思ったもののうまくいきません。
ひとまず、返り値の確認のため、下記のようなコードを書きましたが、
Cells(1, 2) = InStrRev(Cells(1, 1), Like "*[0-z]*")
というコードは通らず、
Cells(1, 2) = InStrRev(Cells(1, 1), Cells(1, 1) Like "*[0-z]*")
というコードは返り値が0になってしまいます。
上記のような場合、どのようなコードが適していますでしょうか。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
A列に"aa"の文字列が含まれる場合、その行を非表示にして、印刷する。
"aa"の文字列が無かった場合は印刷しない。
というコードを書きたいのですが、分からず困っています。
Dim EndRow As Long
Dim i As Long
EndRow = cells(Rows.Count, 1).End(xlup).Row
For i = 1 To EndRow
If Cells(i, 1) = "aa" Then Rows(i).EntireRow.Hidden = 1
Next
で一行ずつ調べていって非表示にすることはできましたが、その後がわかりません。
上記のような場合、どのようなコードが適していますでしょうか。
なお、上記For Next文は必ず使いたいというわけではありません。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
こちらの識者の方々にはいつもお世話になっています。
VBAの質問です。
環境は下記になります。
OS=windowsXP SP3
Office=Excel2003(11.8347.8403) SP3
A列に"aa"の文字列が含まれる場合、その行を非表示にして、印刷する。
"aa"の文字列が無かった場合は印刷しない。
というコードを書きたいのですが、分からず困っています。
Dim EndRow As Long
Dim i As Long
EndRow = cells(Rows.Count, 1).End(xlup).Row
For i = 1 To EndRow
If Cells(i, 1) = "aa" Then Rows(i).EntireRow.Hidden = 1
Next
で一行ずつ調べていって非表示にすることはできましたが、その後がわかりません。
上記のような場合、どのようなコードが適していますでしょうか。
なお、上記For Next文は必ず使いたいというわけではありません。
質問に不備不足等ございましたらご指摘ください。
ご面倒お掛けしますがよろしくお願いします。
VBAの知識がなく、コピペで作業しています。
笑わないで見てください。
作業内容は
「集計用フォルダ内にあるファイル（60個くらいあります）の情報を取得してデータベース化する」
です。
下記のプログラムを作ってみたのですが、ThisWorkbookに各ファイルのデータが
一行ずつずれて貼り付けられてしまい、最終行の一つ下に貼り付けられていません。
画面を見ていると、ファイルは一つずつ開いて閉じてを繰り返しているのですが、
貼り付けは一括で行われます。
ThisWorkbookの扱いで、散々苦労して作ったのですが、あと一歩というところで
つまづいてしまいました。
アドバイス、よろしくお願いいたします。
Sub フォルダ内エクセルファイル値取り出し()
Dim FName As String
Dim FPath As String
Dim cnt As Integer
Dim r As Long
'画面更新オフ
Application.ScreenUpdating = False
'累積データがある列のデータ下端を取得
cnt = Cells(Rows.Count, 1).End(xlDown).Offset(1, 0).Row
FPath = "C:\Documents and Settings\******\デスクトップ\集計用フォルダ(このフォルダは書込み専用です）" '対象フォルダのパス
ChDir FPath
FName = Dir("*.xls")
Do While FName <> ""
Workbooks.Open FName
Worksheets(1).Range(Selection, ActiveCell.SpecialCells(xlLastCell)) _
.Copy Destination:=ThisWorkbook.Sheets(1).Cells(cnt, 1)
cnt = cnt + 1
ActiveWorkbook.Close
FName = Dir()
Loop
'画面更新オン
Application.ScreenUpdating = True
End Sub
VBAの知識がなく、コピペで作業しています。
笑わないで見てください。
作業内容は
「集計用フォルダ内にあるファイル（60個くらいあります）の情報を取得してデータベース化する」
です。
下記のプログラムを作ってみたのですが、ThisWorkbookに各ファイルのデータが
一行ずつずれて貼り付けられてしまい、最終行の一つ下に貼り付けられていません。
画面を見ていると、ファイルは一つずつ開いて閉じてを繰り返しているのですが、
貼り付けは一括で行われます。
ThisWorkbookの扱いで、散々苦労して作ったのですが、あと一歩というところで
つまづいてしまいました。
アドバイス、よろしくお願いいたします。
Sub フォルダ内エクセルファイル値取り出し()
Dim FName As String
Dim FPath As String
Dim cnt As Integer
Dim r As Long
'画面更新オフ
Application.ScreenUpdating = False
'累積データがある列のデータ下端を取得
cnt = Cells(Rows.Count, 1).End(xlDown).Offset(1, 0).Row
FPath = "C:\Documents and Settings\******\デスクトップ\集計用フォルダ(このフォルダは書込み専用です）" '対象フォルダのパス
ChDir FPath
FName = Dir("*.xls")
Do While FName <> ""
Workbooks.Open FName
Worksheets(1).Range(Selection, ActiveCell.SpecialCells(xlLastCell)) _
.Copy Destination:=ThisWorkbook.Sheets(1).Cells(cnt, 1)
cnt = cnt + 1
ActiveWorkbook.Close
FName = Dir()
Loop
'画面更新オン
Application.ScreenUpdating = True
End Sub
エクセル２００７です。
以下のマクロで、inputboxメソッドで質問させると、キャンセルボタンを押すと、うまいぐあいに止まります。
しかし、０を押しても、止まってしまいます。本当は、Ｃ２にゼロと表示させたいのです。
Sub 練習()
Dim myR
myR = Application.InputBox(prompt:="数量を入力しなさい", Type:=1)
If myR = False Then Exit Sub
Range("C2").Value = myR
End Sub
コンボボックスに日付（30日前まで）が入っています。
For i = 0 To 30
ComboBox1.AddItem Date - i
Next
そして、選択された日付から今日までの日数で
ループを実行させたいのです。
例 9/28 今日 10/30 → 30回数実行？
考え方が良く分からなかったため、
コンボボックスの値と比較しようとしました。
Function Count()
Dim SelectDate As Date
Dim Today As Date
SelectDate = ComboBox1.Value
Today = Date
For i = 0 To SelectDate = Today Step 1
SelectDate = DateAdd("d", i, SelectDate) '(”d”は日数）
Next
MsgBox "見つかりました" & J
EndNumber = J
Count = EndNumber
End Function
これでは、何を選択しても
上手くいきません（思い通りの数値が出ません）
何が悪いのでしょうか？
何か良い方法がありましたら、知恵をお貸しください。
コンボボックスに日付（30日前まで）が入っています。
For i = 0 To 30
ComboBox1.AddItem Date - i
Next
そして、選択された日付から今日までの日数で
ループを実行させたいのです。
例 9/28 今日 10/30 → 30回数実行？
考え方が良く分からなかったため、
コンボボックスの値と比較しようとしました。
Function Count()
Dim SelectDate As Date
Dim Today As Date
SelectDate = ComboBox1.Value
Today = Date
For i = 0 To SelectDate = Today Step 1
SelectDate = DateAdd("d", i, SelectDate) '(”d”は日数）
Next
MsgBox "見つかりました" & J
EndNumber = J
Count = EndNumber
End Function
これでは、何を選択しても
上手くいきません（思い通りの数値が出ません）
何が悪いのでしょうか？
何か良い方法がありましたら、知恵をお貸しください。
