Javaに関する様々な情報をご紹介します。

Javaに関する様々な情報をご紹介します。
評価

0

これでいい?

Option Explicit 

Public Sub DataRead() 

    '◆比較するフィールドを設定(0番から始まる番号) 
    Const clngKey As Long = 15 
     
    Dim i As Long 
    Dim vntFileName As Variant 
    Dim lngRow As Long 
    Dim strPath As String 
    Dim rngResult As Range 
    Dim vntCompe As Variant 
    Dim vntRead As Variant 
    Dim strProm As String 
  
    '◆比較する値を設定 
    vntCompe = "9100" 
     
    '◆出力するフィールドを設定(0番から始まる番号) 
    vntRead = Array(3, 4, 10, 14, 15) 
     
    '◆指定形式のファイル名を取得 
    strPath = ThisWorkbook.Path 
    If Not GetReadFile(vntFileName, strPath) Then 
        strProm = "マクロがキャンセルされました" 
        GoTo Wayout 
    End If 

    '◆出力先頭セル位置を設定(基準セル位置) 
    Set rngResult = ActiveSheet.Cells(1, "A") 
     
    '画面更新を停止 
    Application.ScreenUpdating = False 
         
    'データの読み込み 
    CSVRead vntFileName, rngResult, lngRow, clngKey, vntCompe, vntRead 

    strProm = "処理が完了しました" 

Wayout: 

    Set rngResult = Nothing 

    '画面更新を再開 
    Application.ScreenUpdating = True 

    MsgBox strProm, vbInformation 

End Sub 

Private Sub CSVRead(ByVal strFileName As String, _ 
                    ByRef rngWrite As Range, _ 
                    ByRef lngRow As Long, _ 
                    ByRef lngKey As Long, _ 
                    ByRef vntCompe As Variant, _ 
                    ByRef vntRead As Variant, _ 
                    Optional strDelim As String = ",") 

    Dim i As Long 
    Dim dfn As Integer 
    Dim vntField As Variant 
    Dim strBuff As String 
    Dim blnMulti As Boolean 
    Dim strRec As String 
    Dim lngTop As Long 
    Dim lngSheetsCount As Long 
    Dim lngMax As Long 
    Dim vntResult As Variant 
     
    'シート基準行位置を取得 
    lngTop = rngWrite.Row 
    '書き込みシート数 
    lngSheetsCount = 1 
    '出力列数を取得 
    lngMax = UBound(vntRead) 
    '出力用配列を確保 
    ReDim vntResult(lngMax) 
     
    'ファイルをOpen 
    dfn = FreeFile 
    Open strFileName For Input As dfn 

    Do Until EOF(dfn) 
        '1行読み込み 
        Line Input #dfn, strBuff 
        '論理レコードに物理レコードを追加 
        strRec = strRec & strBuff 
        '論理レコードをフィールドに分割 
        vntField = SplitCsv(strRec, strDelim, , , blnMulti) 
        'フィールド内で改行が有る場合 
        If Not blnMulti Then 
            'Keyと同じ値なら 
            If vntField(lngKey) = vntCompe Then 
                '出力フィールドを転記 
                For i = 0 To lngMax 
                    vntResult(i) = vntField(vntRead(i)) 
                Next i 
                With rngWrite.Offset(lngRow).Resize(, UBound(vntResult) + 1) 
                    '出力範囲を文字列に設定 
'                    .NumberFormat = "@" 
                    'データを出力 
                    .Value = vntResult 
                End With 
                '出力行をインクリメント 
                lngRow = lngRow + 1 
                '書き込み行が、SheetEndを超えた場合 
                If lngRow > Rows.Count - lngTop Then 
                    With rngWrite 
                        '書き込み行を初期値に 
                        lngRow = 0 
                        'シートを追加 
                        Set rngWrite = .Parent.Parent.Worksheets. _ 
                                        Add(after:=.Parent).Cells(.Row, .Column) 
                        '書き込みシート数 
                        lngSheetsCount = lngSheetsCount + 1 
                        DoEvents 
                    End With 
                End If 
            End If 
            strRec = "" 
        Else 
            'セル内改行として残す場合 
            strRec = strRec & vbLf 
        End If 
    Loop 

    Close #dfn 

End Sub 

Private Function SplitCsv(ByVal strLine As String, _ 
                        Optional strDelimiter As String = ",", _ 
                        Optional strQuote As String = """", _ 
                        Optional strRet As String = vbCrLf, _ 
                        Optional blnMulti As Boolean) As Variant 

    Dim i As Long 
    Dim lngDPos As Long 
    Dim vntData() As Variant 
    Dim lngStart As Long 
    Dim vntField As Variant 
    Dim lngLength As Long 

    i = 0 
    lngStart = 1 
    lngLength = Len(strLine) 
    blnMulti = False 
    Do 
        ReDim Preserve vntData(i) 
        If Mid$(strLine, lngStart, 1) <> strQuote Then 
            lngDPos = InStr(lngStart, strLine, _ 
                        strDelimiter, vbBinaryCompare) 
            If lngDPos > 0 Then 
                vntField = Mid$(strLine, lngStart, _ 
                                    lngDPos - lngStart) 
                If lngDPos = lngLength Then 
                    ReDim Preserve vntData(i + 1) 
                End If 
                lngStart = lngDPos + 1 
            Else 
                vntField = Mid$(strLine, lngStart) 
                lngStart = lngLength + 1 
            End If 
        Else 
            lngStart = lngStart + 1 
            Do 
                lngDPos = InStr(lngStart, strLine, _ 
                                strQuote, vbBinaryCompare) 
                If lngDPos > 0 Then 
                    vntField = vntField & Mid$(strLine, _ 
                                lngStart, lngDPos - lngStart) 
                    lngStart = lngDPos + 1 
                    Select Case Mid$(strLine, lngStart, 1) 
                        Case "" 
                            Exit Do 
                        Case strDelimiter 
                            lngStart = lngStart + 1 
                            Exit Do 
                        Case strQuote 
                            lngStart = lngStart + 1 
                            vntField = vntField & strQuote 
                    End Select 
                Else 
                    blnMulti = True 
                    vntField = Mid$(strLine, lngStart) 
                    lngStart = lngLength + 1 
                    Exit Do 
                End If 
            Loop 
        End If 
        vntData(i) = vntField 
        vntField = Empty 
        i = i + 1 
    Loop Until lngLength < lngStart 

    SplitCsv = vntData() 

End Function 

Private Function GetReadFile(vntFileNames As Variant, _ 
                        Optional strFilePath As String, _ 
                        Optional blnMultiSel As Boolean _ 
                                        = False) As Boolean 

    Dim strFilter As String 
     
    'フィルタ文字列を作成 
    strFilter = "CSV File (*.csv),*.csv," _ 
                & "Text File (*.txt),*.txt," _ 
                & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _ 
                & "全て (*.*),*.*" 
    '読み込むファイルの有るフォルダを指定 
    If strFilePath <> "" Then 
        'ファイルを開くダイアログ表示ホルダに移動 
        ChDrive Left(strFilePath, 1) 
        ChDir strFilePath 
    End If 
    'もし、ディフォルトのファイル名が有る場合 
    If vntFileNames <> "" Then 
        SendKeys vntFileNames & "{TAB}", False 
    End If 
    '「ファイルを開く」ダイアログを表示 
    vntFileNames _ 
            = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel) 
    If VarType(vntFileNames) = vbBoolean Then 
        Exit Function 
    End If 
     
    GetReadFile = True 
     
End Function 

11

回答

7391

閲覧

11件の回答

評価

0

#2です。非連続な列群を指定した場合に対応させてみました。ご参考まで。
Unionに各範囲を与えるところは、ご自分でお願いします。
Sub test()
Dim targetRange As Range, myArea As Range, myColumn As Range
Dim i As Long, j As Long, columnCount As Long
Dim buf As Variant, buf2 As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetRange = Union(Range("a1:a3"), Range("c1:d3"), Range("f1:f3"))
'データチェック 先頭行位置、行数の一致チェック 必要ならご自分で作成下さい。
'If Not checkRanges(targetRange) Then Exit Sub
For Each myArea In targetRange.Areas
columnCount = columnCount + myArea.Columns.Count
Next myArea
With FSO.createTextFile("C:\Sample.txt", True) 'overwrite
For i = 1 To targetRange.Areas(1).Rows.Count
ReDim buf(1 To columnCount)
j = 1
For Each myArea In targetRange.Areas
For Each myColumn In myArea.Columns
buf(j) = myColumn.Cells(i).Text 'Value
j = j + 1
Next myColumn
Next myArea
buf2 = Join(buf, ",")
.writeline buf2
Next i
.Close
End With
End Sub 

評価

0

VBAを堂々と投稿するのは初めてかもね。

評価

0

指定したエクセルの列を読み取るにはどうしたらいいですか?

評価

0

初心忘るべからず、だろか。

指定された列を目で見れば読み取れると思うよ。

…Javaの掲示板でVBAの漠然とした質問をして、答えがちゃんと返ってくると思う?
VBAの質問ができるところへ行ったほうがいいよ。

評価

0

主にとってはこれは「Java」なんだろう。
もっと勉強してくださいな。

評価

0

何?javaとの関連?
VBAはエクセルかAccessですよね?
このようなソースをjava風に描きたいですか?

ソース内容↓
エクセルからデータを読み込んで⇒取ってきたい値のCSVを吐き出す

みたいなぁ

評価

0

Javaの道 掲示板 ガイドラインを見る限り、
『Java関連の質問以外してはならいない』という項目はないんですよね。

それに、Java以外の事が質問されていても、違反ということで、削除されたりしてない所をみると、実はなんでも掲示板なんじゃないだろうか。

どう思いますか?

▼おすすめサイト
http://www.vbalab.net/

評価

0

「Javaの道 掲示板はJavaに関係する人が集まり、互いの知
識を補完しながら問題解決を行う場です。」
とあります。
まぁ、
「Javaに関係する人が集まり、互いの知識を補完しながら
VBAの問題も解決します。」
と捉えることも出来なくは無いですが・・・
効率は悪そうですね。

評価

0

こういう連中って、スレ主へのアドバイスは、
絶対にしないんだよな。

評価

0

ガイドライン抜粋
掲示板とは、共通の分野に関係する人が集まり、互いの知識を補完しながら問題の解決を図っていく場です(一方的に回答が得られるサポートセンターではありません。

>「Javaの道 掲示板はJavaに関係する人が集まり、互いの知
識を補完しながら問題解決を行う場です。」

どこにも書いてないですね。

不良社員へ
サイトを紹介してまんがな。
あなたこそ、アドバイスがないですね。

評価

0

ガイドラインではなく、掲示板の一番上に書いてますね
変子に捉える事もできますね。

まぁ少し疑問が晴れました。
ありがとう御座います。

質問から6ヶ月以上経過しているので、回答を書き込むことはできません。