[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルから必要なデータだけ読み取ってエクセルにまとめたい』（ピアノｃ）
ご質問させていただきます。
テキストファイルではないですがメモ帳で開くことの出来るファイルから、
複数のデータを抜き取ってエクセルファイルに入れたいです。
それは可能でしょうか？？
かなりの量のファイルがあり全て手作業ですると結構な時間がかかってしまいます。
申し訳ないのですが、アドバイスをいただけるとうれしいです。
よろしくお願いします。
＜ 使用 アプリ：Excel2003とExcel2010、使用 OS：WindowsXP ＞
＞それは可能でしょうか？？ んーー、 可能かと問われれば、 「手作業でできていることならマクロでできるかもしれません。 が、それっぽちの情報では具体的アドバイスは不可能です」 という答えしか返せません。 つまり、質問自体があいますぎですね。 ファイル形式（拡張子） メモ帳で開いた状態のデータ（テキストファイルの具体的内容） そこから何をどういう基準で抜き出し、エクセルへどのように転記したいのか。 すなわち、ピアノｃさんがやっていることを、 掲示板を読んでいる回答者が再現できるような情報があれば、 具体的なアドバイスを得られます。 （みやほりん） 2014/01/17(金) 14:16
形式は語尾が「.o」になってますが、
形式を選択して開く？でメモ帳を選べばその形式のファイルはメモ帳で開けました。
行がついておりまして、一部を抜き出してみますと、
#---------------------------------------------------------------#
# Memory information
#---------------------------------------------------------------#
Physical Memory Size : 67091348 KBytes
Virtual Memory Size : 132549996 KBytes
このようなデータが何行も入っております。
そんなファイルデータの中から、19個分のデータを抜き出したく、
#---------------------------------------------------------------#
# OS information
#---------------------------------------------------------------#
Operating System : Microsoft(R) Windows(R) XP 〜〜〜〜〜〜 ↑: の後の文字列がC3から下に入るように。
#---------------------------------------------------------------#
# Basic System information
#---------------------------------------------------------------#
Model : HP 〜〜〜 Workstation
System Type : 〜〜〜-based PC →Model： の後の文字列をD3から下に。 →System Type: の後の文字列をE3から下に。
#---------------------------------------------------------------#
# Memory information
#---------------------------------------------------------------#
Physical Memory Size : 67091348 KBytes
Virtual Memory Size : 132549996 KBytes →Physical Memory Size: から後の文字列をF3から下に。 →Virtual Memory Size: から後の文字列をG3から下に。
#---------------------------------------------------------------#
# Graphic Adapter information
#---------------------------------------------------------------#
Name : NVIDIA Quadro FX 1800
〜〜色々間に入ってる〜〜〜
Driver Version : 6.14.11.9178 →Name: の後の文字列をH3から下に、 →Driver Version: の後の文字列をI3から下に。
A: ←これはA・C・D・Eの４種類あります。
========
Drive Type : ★★★
File System : ★★★
Size : 20481 MB
Free Space : 10034 MB
Drive Type: から後の文字列をJ3から下に、
File System: から後の文字列をK3から下に。
Size: から後の文字列をL3から下に。
Free Space: から後の文字列をM列に。
残り、C・D・Eとあるのですが、
上記と同じようにCの結果はN〜Qへ、
Dの結果はR〜Uへ、Eの結果はV〜Y列へ入れたいです。
B3以降のB列にはそのファイル名を入れたいです。
理想としてはフォルダを選んだらその中のファイルをまとめてくれる形がいいなぁと・・・。
ちなみになのですが、一部のところには「: 」のあとに文字列がなく、空欄の場合もあります。
そのときはエクセルの該当するセルは空欄がいいです。
これは可能でしょうか、、？
もし「これは無理！」というようなものでしたら手作業でがんばります。
改めましてよろしくお願いします、（長文で申し訳ないです）
（ピアノｃ） 2014/01/17(金) 14:40
マクロになります。 マクロの登録の仕方は（2003） 1) Alt+F11を押す。 2) 挿入-->標準モジュールを選択。 3) 出てきた画面にコードをコピペして閉じる。 4) Alt+F8を押して、test20130117を選択して実行。
Option Explicit
Sub test20130117()
Dim fn As String, temp, x, y
Dim myR As Long, i As Long, myCol As Long
Rem ファイル保存フォルダパス
Const dirN As String = "C:\test\"
Rem 記録するシート名
Const strShName As String = "Sheet1"
fn = Dir(dirN & "*.o")
Do While fn <> ""
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(dirN & fn).ReadAll
x = Split(temp, vbCrLf)
With ThisWorkbook.Worksheets(strShName)
myR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
For i = 0 To UBound(x)
y = Split(x(i), ":")
Select Case Replace(Trim(y(0)), Chr(9), "")
Case "Operating System"
.Cells(myR, 3).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Model"
.Cells(myR, 4).Value = Replace(Trim(y(1)), Chr(9), "")
Case "System Type"
.Cells(myR, 5).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Physical Memory Size"
.Cells(myR, 6).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Virtual Memory Size"
.Cells(myR, 7).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Name"
.Cells(myR, 8).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Driver Version"
.Cells(myR, 9).Value = Replace(Trim(y(1)), Chr(9), "")
Case "A"
myCol = 0
Case "C", "D", "E"
myCol = myCol + 4
Case "Drive Type"
.Cells(myR, 10 + myCol).Value = Replace(Trim(y(1)), Chr(9), "")
Case "File System"
.Cells(myR, 10 + myCol + 1).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Size"
.Cells(myR, 10 + myCol + 2).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Free Space"
.Cells(myR, 10 + myCol + 3).Value = Replace(Trim(y(1)), Chr(9), "")
End Select
Next
End With
fn = Dir()
Loop
End Sub
C2セルに見出しなどが入力されていることを前提に作っています。 保存フォルダ名、書き出すシート名はそちらの環境に合わせて書き直してください。 ご提示いただいたテキストの仕様に基づいて検証はしていますが、 2003の環境しかないので2010での動作は保証できません。 それと、うまく動かなくても、すぐにはフォローできませんので、ご容赦を。
（みやほりん） 2014/01/17(金) 19:26
実行してみたのですが、
AのDrive Type・File System・Size・Free Space
のところが空欄（というか行がそもそもない）
データはA以降のC・D・Eの場所がズレて入っちゃっています。
Aがあるところはズレずに綺麗に入っているのですが何故か分かりません；
急ぎでないのでせかしてしまっていたら申し訳ないです。
ズレを直せましたらよろしくお願い致します。
（ピアノｃ） 2014/01/20(月) 10:06
Case "A"
myCol = 0
Case "C", "D", "E"
myCol = myCol
上記４ステートメントがうまく働いていない可能性がありますね。
改行コードだけの空行はない、
ドライブの部分以外で同じステータスの繰り返しはない、
コード160の半角スペースはない、
など勝手に推測して作っている部分はありますが、
こちらで作ったサンプルではA、C、D、Eの各４ステータスが
J:Y列に収まってるんですよねぇ・・・。
件のテキストのドライブ部分は次のような並び方だと推測してますが、
いかがでしょうか？
A:
========
Drive Type : ★★★A
File System : ★★★A
Size : 20481 MBA
Free Space : 10034 MBA
C:
========
Drive Type : ★★★C
File System : ★★★C
Size : 20481 MBC
Free Space : 10034 MBC
D:
========
Drive Type : ★★★D
File System : ★★★D
Size : 20481 MBD
Free Space : 10034 MBD
E:
========
Drive Type : ★★★E
File System : ★★★E
Size : 20481 MBE
Free Space : 10034 MBE
（末尾のアルファベットは識別マーク。動作に影響はないはず）
あと、一度検証不足のコードを投稿してしまったかもしれないので、
（二日前のことなのに覚えてない・・・）
手元の新しいものを下記に提示しておきます。
改めてこちらでも試してみてください。
Option Explicit
Sub test20130117_2()
Dim fn As String, temp, x, y
Dim myR As Long, i As Long, myCol As Long
Rem ファイル保存フォルダパス
Const dirN As String = "C:\test\"
Rem 記録するシート名
Const strShName As String = "Sheet1"
fn = Dir(dirN & "*.o")
Do While fn <> ""
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(dirN & fn).ReadAll
x = Split(temp, vbCrLf)
With ThisWorkbook.Worksheets(strShName)
myR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
For i = 0 To UBound(x)
If Len(x(i)) > 0 Then
y = Split(x(i), ":")
Select Case Replace(Trim(y(0)), Chr(9), "")
Case "Operating System"
.Cells(myR, 3).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Model"
.Cells(myR, 4).Value = Replace(Trim(y(1)), Chr(9), "")
Case "System Type"
.Cells(myR, 5).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Physical Memory Size"
.Cells(myR, 6).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Virtual Memory Size"
.Cells(myR, 7).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Name"
.Cells(myR, 8).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Driver Version"
.Cells(myR, 9).Value = Replace(Trim(y(1)), Chr(9), "")
Case "A"
myCol = 0
Case "C", "D", "E"
myCol = myCol + 4
Case "Drive Type"
.Cells(myR, 10 + myCol).Value = Replace(Trim(y(1)), Chr(9), "")
Case "File System"
.Cells(myR, 10 + myCol + 1).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Size"
.Cells(myR, 10 + myCol + 2).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Free Space"
.Cells(myR, 10 + myCol + 3).Value = Replace(Trim(y(1)), Chr(9), "")
End Select
End If
Next
End With
fn = Dir()
Loop
End Sub
（みやほりん） 2014/01/20(月) 14:26
元データのA関連がないことがあります；
C:
========
Drive Type : ★★★C
File System : ★★★C
Size : 20481 MBC
Free Space : 10034 MBC
D:
========
Drive Type : ★★★D
File System : ★★★D
Size : 20481 MBD
Free Space : 10034 MBD
E:
========
Drive Type : ★★★E
File System : ★★★E
Size : 20481 MBE
Free Space : 10034 MBE
上記のようなデータが何個かのファイルに入っています。
Aのデータ自体がないからずれてしまっているのでしょうか？？
新しいレスのコードも試させていただいたのですが、
やはりAのデータが存在しないファイルだけCからズレて入っており、
その後の他ファイルのデータはきちんと入っています。
説明も不足してしまっていました、たびたび申し訳ないです；；
（ピアノｃ） 2014/01/20(月) 14:47
なるほど、了解です。 A:、C:、D:、E:が揃っている、と思っていたので、どれかがない事態は想定してなかった。 変数myColがリセットされずにループしています。 A:があれば、変数myColに０が代入されるので、想定どおりの動きをするはずですが、 ないときには、前回のDoループでmyCol=12に設定されたまま実行されるので 想定より１２列右側にデータが入ってしまいますね。
myR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
myCol = 0
上記の位置に変数myColを０に戻すステートメントを入れてみてください。
ですがもしかすると、C:、D:、E:も欠ける時があるのかしらん？
Case "C", "D", "E"
myCol = myCol + 4
も前回のForループの値に頼らず、
Case "C"
myCol = 4
Case "D"
myCol = 8
Case "E"
myCol = 12
としたほうが良いかもしれません。
（みやほりん） 2014/01/20(月) 15:13
遅れました；
みやほりんさんの通り書き換えて見た結果ズレずに処理されました！♪
CとDとEは、今手元にあるデータではどれかかけてる〜というのはないのですが、
Case "C"
myCol = 4
Case "D"
myCol = 8
Case "E"
myCol = 12
でやりました！
Aというのはプロッピー？フロッピー？ディスクのドライブみたいで、
PCにないのもあるみたいでした＾＾；
土日をまたいで時間を取らせてしまいすみませんｍ（＿＿）ｍ
大変助かりました♪本当にありがとうございます！
（ピアノｃ） 2014/01/20(月) 17:12
（みやほりん） 2014/01/20(月) 18:08
時間が経ってからで申し訳ないです＞＜
（ピアノｃ） 2014/01/27(月) 11:31
本当に何も入っていないファイルを処理した場合、ReadAllメソッドで
「実行時エラー'62':ファイルにこれ以上データがありません」になります。
vbCrLf（改行）だけのファイルなら何も転記されずに次のファイルの処理が
行われます。
もしかしたら On Error Resume Next を追加しているのかもしれませんね。
その場合は空ファイルの時には、変数tempにその前のデータが残っているので
同じデータを繰り返して出力してしまいます。
行儀の悪いコードですねぇ。
On Error Resume Next'★追加
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(dirN & fn).ReadAll
If Err.Number = 62 Then'★追加
On Error GoTo 0'★追加
temp = Empty'★追加
End If'★追加
tempをセットする前後に上記の様に追加してみてもらえますか？
（みやほりん） 2014/01/27(月) 12:30
> 何にもデータが入っていないファイルがあり、 FileLen で確認する方法もあります。
If FileLen(fn) Then
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(dirN & fn).ReadAll
処理
End If
（seiya） 2014/01/27(月) 12:43
ちなみに、今みやほりんさんのコードのちょっと変えたやつを入れて
Case "Host name"
.Cells(myR, 2).Value = Replace(Trim(y(1)), Chr(9), "")
これでファイル名（hostname）をB列に入れているのですが、
ファイル名をセルに入れる方法も教えていただけますでしょうか？
この方法だと全くデータがないファイルに関してなにも情報が残らずして；
（ピアノｃ） 2014/01/27(月) 13:58
＞ですが今の所空白行がデータのある行と行の間には入ってません；
＞全くデータがないファイルに関してなにも情報が残らず
それはそうでしょうねぇ・・・
空ファイル以外は「Host name:xxxxxxxxxx」というデータがあるかと思われますから
データの中からそれを見つければよいのですが、空ファイルはそれさえもないので、
ファイル名そのものを取得するしかありませんよね。
書き込み行はC列で判断しています。
空ファイルはC列への書き込みも行われないので、空白行にはなりません。
つまり、私の想定したマクロは「ファイルの数」ではなくて、
「すでにC列に書き込まれているデータの最終位置」を基準に
書き込み行を決めています。
B列にファイル名を羅列、空ファイルでも書き込んでいく場合は下記のような位置に
Dir関数で取得できているfnを書き込み。
myR = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(myR, 2).Value = fn
というか、
＞B列にはそのファイル名を入れたいです。
見落としていました。
これは私が悪かったです。
（みやほりん） 2014/01/27(月) 14:32
>seiyaさんのコードを試してみたのですが同じデータが2行なってしまいました； 私はFileLen関数を使用してFileにデータがあるかどうかの確認をすることのみをチェックをする、 ということを言いたいだけでしたが...
私なら(未検証)
Sub test()
Dim myDir As String, fn As String, txt As String, temp As String
Dim n As Long, i As Long, ii As Long, myCol As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then myDir = .SelectedItems(1) & "\"
End With
If myDir = "" Then Exit Sub
fn = Dir(myDir & "*.o")
Do While fn <> ""
If FileLen(myDir & fn) Then
n = n + 1: Cells(n, 2).Value = fn
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "([ACDE]):[^\n]*\n[\s\t]*=+[^\n]*\n *Drive Type[\s\t]*:[\s\t]*(\S[^\n]+)\n" & _
"[\s\t]*File System[\s\t]*:[\s\t]*(\S[^\n]+)\n[\s\t]*Size[\s\t]*:[\s\t]*(\S[^\n]+)\n[\s\t]*" & _
"Free Space[\s\t]*:[\s\t]*(\S[^\n]+)"
If .test(txt) Then
For i = 0 To .Execute(txt).Count - 1
temp = .Execute(txt)(i).submatches(0)
myCol = InStr("ACDE", temp) * 4 + 10
For ii = 1 To 4
Cells(n, myCol + ii - 1).Value = .Execute(txt)(i).submatches(ii)
Next
Next
End If
End With
End If
fn = Dir
Loop
End Sub
（seiya） 2014/01/27(月) 15:35
Range("A4").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],3)"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A65536"), Type:=xlFillDefault
マクロの記録？でこれが出来まして、最後の方にいれてみたのですが無駄に式が入ってしまって；
seiyaさん
下のほうにseiyaさんのコードを貼らせていただきまして、
Callで呼び出すようにしてみたのですが途中でファイル名の書き込みが止まってしまいました；
あと勘違いをしてしまい申し訳ありません＞＜
てっきりIF文の意味はファイルにデータがなかったら次の行にする〜みたいなものだと思っておりました；
（ピアノｃ） 2014/01/27(月) 16:19
>下のほうにseiyaさんのコードを貼らせていただきまして、 > Callで呼び出すようにしてみたのですが...
どのように使用しているか不明ですが、私のコードは単独で実行されなければなりません。 こちらで簡易ファイルを作成して試しましたが、問題なく動作してます。 （seiya） 2014/01/27(月) 16:31
（ピアノｃ） 2014/01/27(月) 16:59
式を入れてから削除するより
最初からループに組んでしまってはどうでしょうか。
myR = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(myR, 1).FormulaR1C1 = "=LEFT(RC[1],3)" 'この行を追加
.Cells(myR, 2).Value = fn
（みやほりん） 2014/01/27(月) 17:24
私のコードだと
> n = n + 1: Cells(n, 2).Value = fn を n = n + 1: Cells(n, 2).Value = fn: Cells(n, 1).Value = Left$(fn, 3) に変更 （seiya） 2014/01/27(月) 18:04
何度も追加で申し訳ないのですが、別の項目のデータもほしいことになってしまい
自分で書き換えてみたのですが、追加のデータは2行以上あるものがありそのデータが入るところは空欄になってしまいます・・・
Case "Operating System"
.Cells(myR, 3).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Model"
.Cells(myR, 4).Value = Replace(Trim(y(1)), Chr(9), "")
Case "System Type"
.Cells(myR, 5).Value = Replace(Trim(y(1)), Chr(9), "")
★ Case "Serial Number"
.Cells(myR, 6).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Physical Memory Size"
.Cells(myR, 7).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Virtual Memory Size"
.Cells(myR, 8).Value = Replace(Trim(y(1)), Chr(9), "")
Case "IP address"
.Cells(myR, 9).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Subnet"
.Cells(myR, 10).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Default gateway"
.Cells(myR, 11).Value = Replace(Trim(y(1)), Chr(9), "")
Case "DNS servers in search order"
.Cells(myR, 12).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Primary WINS server"
.Cells(myR, 13).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Secondary WINS server"
.Cells(myR, 14).Value = Replace(Trim(y(1)), Chr(9), "") ★
Case "Name"
.Cells(myR, 15).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Driver Version"
.Cells(myR, 16).Value = Replace(Trim(y(1)), Chr(9), "")
Case "A"
myCol = 0
Case "C"
myCol = 4
Case "D"
myCol = 8
Case "E"
myCol = 12
Case "F"
myCol = 16
Case "Drive Type"
.Cells(myR, 17 + myCol).Value = Replace(Trim(y(1)), Chr(9), "")
Case "File System"
.Cells(myR, 17 + myCol + 1).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Size"
.Cells(myR, 17 + myCol + 2).Value = Replace(Trim(y(1)), Chr(9), "")
Case "Free Space"
.Cells(myR, 17 + myCol + 3).Value = Replace(Trim(y(1)), Chr(9), "")
★から★のところまでを付け足してあとは数字をずらして見ました。
データが2行以上あって集計結果が空欄となってしまうのは"DNS servers in search order"という項目です。
2行のデータのものは、
DNS servers in search order :
10.25.12.107
10.25.12.108 こんな風になっていたりします。 出来れば集計結果では「10.25.12.107,10.25.12.108」みたいに2つしっかり入っていて欲しいです。。 どこをどう変えれば結果が反映されるでしょうか？？
追加で質問ばかりしてしまい申し訳ないです；；
（ピアノｃ） 2014/02/03(月) 11:52
VBAは[ピアノｃ]さんのやりたいことをエクセルに伝えるための翻訳文です。 やりたいことが違ったら違った書き方をする必要があります。 「Replace(Trim(y(0)), Chr(9), "")」が「DNS servers in search order」の時は 「.Cells(myR, 12).Value」を「×××」としたい、 この「×××」は「DNS servers in search order」の次の行から始まり、 「Y」という条件までのデータを「Z」という処理を行って「,」で区切って結合した文字列である。 上記文章で ＞「Y」という条件までのデータを「Z」という処理を行って という部分があいまいです。 「2行以上あって」「こんな風に」「みたいに」という「あいまい表現」を 排除して説明するとどうなりますか？
（みやほりん） 2014/02/03(月) 15:48
集計結果に入れるデータが７つ増えました。
そのうち上手くデータが入らないのが２つあり、
★１つ目は
#---------------------------------------------------------------#
# OS information
#---------------------------------------------------------------#
〜この間に７つデータがあります〜
Serial Number : 76597-OEM-5111904-03391
OS informationのSerial Numberの文字が結果に反映されず、
その後にある、
#---------------------------------------------------------------#
# BIOS information
#---------------------------------------------------------------#
〜この間に７つデータがある〜
Serial Number : JPA84600ZB
BIOS informationのSerial Numberが反映されてしまいます。
希望する結果はきちんと「OS informationのSerial Number」のデータが反映されたいです。
★2つ目は、現在
Case "DNS servers in search order"
.Cells(myR, 12).Value = Replace(Trim(y(1)), Chr(9), "")
という追加したコードで集計結果を出そうとしている、
Network informationのNetwork Adapter 1のDNS servers in search orderのデータが、
#---------------------------------------------------------------#
# Network information
#---------------------------------------------------------------#
Network Adapter 1
===================
〜この間に６つデータがあります〜
DNS servers in search order :
10.24.41.40
10.24.41.41 上記のように2行分データがあるせい（空白行以外）で、集計結果は空白セルになります。 希望する結果では、：の後の2つの文字列を「10.24.41.40,10.24.41.41」のように反映されたいです。
追加したデータで今までのコードでは上手くいかないところは以上の２点です。
上手くいかない1つ目のデータはD列に、2つ目のデータはL列に追加したいです。
上のみやほりんさんの文を使って説明したかったのですが、
うまくまとめられずすみません。
長文になってしまいましたがあいまいなところを省いて書いてみました。
希望するものが伝わると嬉しいです＞＜；
（ピアノｃ） 2014/02/03(月) 16:27
＞OS informationのSerial Numberの文字が結果に反映されず、
＞BIOS informationのSerial Numberが反映されてしまいます。
一度は「OS informationのSerial Number」が反映されているはずです。
ですが、「Serial Number」という文言がもう一度現れるので、
分別なく上書きしてくれます。
# OS information の次にかならず
# BIOS information が現れるなら、そこでフラグを立てて、
フラグが立っていたら「Serial Number」という文言が現れても上書きしてはダメよ、
という構造にします。
★2つ目の部分は、必ず２行と決まっていればそのように処理すればよいのですが、
そこがあいまいな部分です。
たぶん、「10.24.41.40」を含む文字列は配列変数「y(0)」に含まれます。
データそのものはおそらく特徴がない（他にも同様のパターンが出現する）ので、
その前後がデータを特定する鍵になります。
先の表現になぞらえると以下の様になるでしょうか。
「DNS servers in search order :」の次に現れる
「？？？？？？？？？？？？？？ ：」までの間のデータを
タブ、スペースなどを取り除いてカンマを挟んで文字列結合したものを
.Cells(myR, 12)に出力する。
で、不明なのが、上記の「？？？？？？？？？？？？？？ ：」の部分です。
私の表現が実際のデータと合っているか、確認願えますか？
（みやほりん） 2014/02/03(月) 18:34
＞# OS information の次にかならず
# BIOS information が現れるなら、そこでフラグを立てて、
フラグが立っていたら「Serial Number」という文言が現れても上書きしてはダメよ、
という構造にします。
1番目についての改善方法が理解できました！
★2番目について
＞「DNS servers in search order :」の次に現れる 「？？？？？？？？？？？？？？ ：」までの間のデータを タブ、スペースなどを取り除いてカンマを挟んで文字列結合したものを .Cells(myR, 12)に出力する。
「？？？？？？？？？？？？？？ ：」の部分は、「 DNS domain : 」になります。
「 DNS domain : 」は見た限り必ず入っています！
（ピアノｃ） 2014/02/04(火) 09:39
Sub test20130117()
Dim fn As String, temp, x, y
Dim flgDNS As boolean,strDNS As String
'−−−−−−−−−−−−−−−−−−略−−−−−−−−−−−−−−−−−−−−−
For i = 0 To UBound(x)
If Len(x(i)) > 0 Then
y = Split(x(i), ":")
Select Case Replace(Trim(y(0)), Chr(9), "")
Case "Operating System"
.Cells(myR, 3).Value = Replace(Trim(y(1)), Chr(9), "")
'−−−−−−−−−−−−−−−−−−略−−−−−−−−−−−−−−−−−−−−−
Case "DNS servers in search order"
flgDNS = True
Case "DNS domain"
flgDNS = False
.Cells(myR, 12).Value = Left(strDNS , Len(strDNS) - 1)
'−−−−−−−−−−−−−−−−−−略−−−−−−−−−−−−−−−−−−−−−
End Select
End If
If flgDNS then
strDNS = strDNS & Replace(Trim(y(0)), Chr(9), "") & ","
End If
Next
'−−−−−−−−−−−−−−−−−−略−−−−−−−−−−−−−−−−−−−−−
ずいぶん間が空いてしまいましたが、もう見ておられないかなぁ。
Case "DNS servers in search order" でフラグ立て
フラグ立っている間は文字列を結合しながらループ、
Case "DNS domain" でフラグ解除、.Cells(myR, 12).Valueへ値代入。
（みやほりん） 2014/04/26(土) 15:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.