スキルアップ・問題解決なら、モーグにおまかせ！

いつもお世話になっています。
単純なことなのかもしれませんが理解が乏しく悩んでいます。
 
csvファイルをExcelに読み込んでいます。
 

With wsKaisha '会社シート

    i = 0
    
    ReDim B(199999, 66)
    Open strFilePath2 For Input As #1 '会社.csvパス名を開く
        Do Until EOF(1)
            Line Input #1, buf
            A = Split(buf, ",")

            For j = 0 To UBound(A)
                B(i, j) = A(j)
            Next j
            i = i + 1 '2行目から開始
        Loop
    Close #1
    
    .Range("A6").Resize(200000, 67) = B
    
    For j = 5 To 66
        .Cells(5, j) = WorksheetFunction.CountA(.Range(.Cells(6, j), .Cells(i, j))) '列のカウント
    Next j

End With

追記です。
 
「1-6」等がある列には他に「部長」等の役職があるものもあります。
全てが「○-○」のような表記ではありません。

引用:
この中で「1-6」等のデータが「1月6日」等に変わってしまいます。
コピー先シートのセルを文字列に設定すると「1-6」で表示されるのですが、
そうすると5行目のCountAが前セルカウントしてしまいます。
元々のセルの設定は　標準　です。

Suzuさん、ありがとうございます。
 

.Cells(5, j) = WorksheetFunction.CountA(.Range(.Cells(6, j), .Cells(i, j)))

>.Cells(5, j) = WorksheetFunction.CountA(.Range(.Cells(6, j), .Cells(i, j)))
この処理では何を求めたいのですか？

WinArrowさん、ありがとうございます。
 
CountAでセルに入力されているものをカウントしたいです。
 
 
色々検索してみて、
 

For j = 7 To 68
.Cells(5, j) = WorksheetFunction.CountIf(.Range(.Cells(6, j), .Cells(r_KaishaEX, j)), "?*") '列のカウント
Next j

 
最初に
> ReDim B(199999, 66)
と、行数（件数）を固定しているのですが、
データ件数は固定なんですか？
 可変ならば、固定化しない方がよい。
  
事前に件数が把握できない場合は、
 固定化できるを1次元目に、可変の方を２次元目にします。
セルに代入する前段階で「行・列」を入れ替えます。
 例
 

Dim Buf As String, FNO As Integer
    i = 0
    ReDim B(66, i)　　　　　　　'★
    FNO = FreeFile
    Open strFilePath2 For Input As #FNO '会社.csvパス名を開く
    Do Until EOF(FNO)
        Line Input #FNO, Buf
        A = Split(Buf, ",")
　　　　ReDim Preserve B(66, i)　　　　'★
        For j = LBound(A) To UBound(A)
            B(j, i) = A(j)　　　　　　'★
        Next j
        i = i + 1 '2行目から開始
    Loop
    Close #FNO
　    B = WorksheetFunction.Transpose(B)　　　’★
    
    .Range("A6").Resize(UBound(B), UBound(B, 2)) = B　　' ★

COUNTIFの使い方に問題あり
 
まず、ワークシートで数式を入力して確かめましょう
空白以外をカウントする場合（例）
=COUNTIF(D6:D20,">""""")
これを参考にしてください。

WinArrow さんの引用:

最初に
> ReDim B(199999, 66)
と、行数（件数）を固定しているのですが、
データ件数は固定なんですか？
 可変ならば、固定化しない方がよい。
  

もう一つ
確かめた方がよいこと
 
長さ=0の文字列は、セルに代入すると
当然ですが、そのまま（長さ=0の文字列（空白文字列という）として）代入されます。
 
それを、「空白」として代入する方法
 
B(x, y) = Iif(A(z) = "", Empty, A(z))
 
多分、これでいけると思います（COUNTA関数対応可）
 

WorksheetFunction.Transpose
を使用する場合の注意事項
データが１件の場合、
２次元配列が１次元配列になる可能性があります。
１件しかないときは、無理やり２件目データ（空白文字列でよい）を追加してください。

問題は、
セルの書式を文字列に指定した場合、
空白のはずのセルが、COUNTA関数の件数に反応してしまう。
 
って事ですね。
 
 
配列を貼り付けた後、空白のはずのセル に対し
ISBLANK関数を使い、BLANKか確認してみましょう。FLASEが返るはずです。
 
何が入っているのかと言うと、空白文字列が入っています。
VBAだと、"" や、vbNullString にて現される文字です。
 
貼り付ける前にローカルウィンドにて配列の値を確認すると「""」になっているはずです。
 
ここが、Variant であれば、Empty になっていれば セルに対し、Emptyが渡され、
ISBLANK は True に。 COUNTA関数でも集計対象にならないです。
 
どこで出ているかと言うと、Split関数です。
戻りは文字列になるので、空白は、"" にて現されます。
( =セル="" とすると True が返る事が判ると思います）
 
1-6 が 日付と認識されない様にする為には、外部データの取り込みは使えませんよね。
となると、今回の様に自前で読み出した後、貼り付け後に、
空白文字列 を Empty に変えるのが良いかと思います。
 
 
が・・
Findメソッドでは、Whatに vbNullString を渡しても 空白文字列のセルのみを
検索する事ができませんでした。(BLANKセルも反応してしまいました)
 
ジャンプの空白セル では、ヒットしないようなので・・
Filter あたりを使うか、For Each にて対象セル(Emptyを含む)に対し Value にEmpty を渡すくらいしか
思いつきません。
 
 
※1. 配列の行列変換は、Transpose で行えば良いのでコードは効率化できるでしょう。
※2. データの読み込みを使い、「1-6」を入れ込む列の書式を文字列に変え
     現状と同じ様に読み込む手も。。

色々ありがとうございます。
 
データが1件もないということはほぼありません。
 
長さ=0の文字列に苦しめられてるのでｗ、
一度やってみます。

別件で忙しく教えてもらったのにすぐに対応できずに申し訳ありません。
先ほど、実証してみました。
 

With wsKaisha '会社シート

    i = 0
    
    ReDim B(66, i)
    FNO = FreeFile
    Open strFilePath2 For Input As #FNO '会社.csvパス名を開く
        Do Until EOF(FNO)
            Line Input #FNO, buf
            A = Split(buf, ",")
            
            ReDim Preserve B(66, i)

            For j = 0 To UBound(A)
                B(j, i) = A(j)
            Next j
            i = i + 1 '2行目から開始
        Loop
    Close #FNO
    
    B = WorksheetFunction.Transpose(B)
    
    .Range("A6").Resize(UBound(B), UBound(B, 2)) = B
    
'    .Range("A6").Resize(200000, 67) = B
    
    For j = 5 To 66
        .Cells(5, j) = WorksheetFunction.CountA(.Range(.Cells(6, j), .Cells(i, j))) '列のカウント
    Next j

End With

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
・
・
・
・
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

追記です。
別問題が出ました。（＾＾；）
 
同じようにしているのですが、全く違うもの。。。というか、順番？が違って貼付されます。
元のデータは下記になります。（一部、ユーザコードがありますのでxx等で表記しています。）
全部で265707件あります。
 
10380,000000,000207000250,経営部,000207000250,,2,0,0,0,●
10380,000000,000000,,000000,,1,0,0,0,●
10380,000001,999999,共通,000001999999,,2,0,0,0,●
10380,000056,999999,東北共通,000056999999,,2,0,0,0,●
xxX004,000000,000001620000,産業,000001620000,,1,0,0,0,●
xxX004,000000,000000,,000000,,1,0,0,0,●
xxX004,000000,000001046000,ガス,000001046000,,2,0,0,0,●
xxX004,000001,620000,産業,000001620000,,1,1,1,1,●
xxX004,000001,046000,ガス部,000001046000,,2,1,1,1,●
xxX004,000056,999999,東北,000056999999,,2,0,0,0,●
 
これを読み込みます。
 

With wsSoshiki '組織シート

    i = 0
    
    ReDim B(10, i)
    FNO = FreeFile
    Open strFilePath3 For Input As #FNO '組織.csvパス名を開く
        Do Until EOF(FNO)
            Line Input #FNO, buf
            A = Split(buf, ",")
            
            ReDim Preserve B(10, i)

            For j = LBound(A) To UBound(A)
                B(j, i) = A(j)
            Next j
            i = i + 1 '2行目から開始
        Loop
    Close #FNO
    
    B = WorksheetFunction.Transpose(B)
    
    .Range("A5").Resize(UBound(B), UBound(B, 2)) = B
    
'    .Range("A5").Resize(300000, 11) = B
    
End With

データの前後関係がよくわかりませんが・・・

ブレークポイントを設定したり、ステップ実行で確認してみて下さい。
 
CSV読込と途中で
3500件目で止める場合
If i >3500 Then Stop
 
と入れると、そこで止まりますから
そこあらF8を押しながらデータの内容を確認してみるとよいでしょう。
 
 
 
 
 
 

読み込み全数に対し、配列を組みなおしたりしているので、遅くて当然です。
 
物は試しで
外部データの取込を試してみてはいかがでしょう？
(20/12/04 16:25:04 の例では 10列だったので、10列の設定にしています)
 
Sub TEST()
 With ActiveSheet.QueryTables.Add( _
        Connection:="TEXT;C:\〜〜\DATA.CSV", _
        Destination:=Range("$A$1"))
  .TextFilePlatform = 932
  .TextFileCommaDelimiter = True
  .TextFileColumnDataTypes = _
        Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2) '←列数分、2を並べます(2は文字列として取り込むの意)
  .Refresh BackgroundQuery:=False
End With
End Sub
 
 
26万件のデータがあって、最初の提示のコードでは 20万件×66列の設定ですけど良いのでしょうか？
 
そもそも26万件のデータをExcelで処理と言うのはした事ないので、動くかわかりません。
CSVに出力する際に、必要分だけに絞る事はできないのでしょうか？
 
どうしてもクライアント側で処理しないといけないのであれば、
当方ならAccessを使うか、取込む際に、JET経由で絞込みますね。

たくさんのアドバイス、ありがとうございます。
 
まずは配列がおかしくなる？ものからみてみました。
STOPがかかるところまでは　B　にはきちんとデータが入っていました。
 
 

With wsSoshiki '組織シート

    i = 0

    ReDim B(10, i)
    FNO = FreeFile
    Open strFilePath3 For Input As #FNO '組織.csvパス名を開く
        Do Until EOF(FNO)
            Line Input #FNO, buf
            A = Split(buf, ",")

            ReDim Preserve B(10, i)

            For j = LBound(A) To UBound(A)
                B(j, i) = A(j)
            Next j
            i = i + 1 '2行目から開始
        Loop
    Close #FNO
Stop
    B = WorksheetFunction.Transpose(B)

    .Range("A5").Resize(UBound(B), UBound(B, 2)) = B

'    .Range("A5").Resize(300000, 11) = B

End With

    B = WorksheetFunction.Transpose(B)

Suzuさん
 
ありがとうございます。
説明不足で申し訳ないです。
 
実際には4つのcsvファイルを取り込みます。
ひとつは最初にコードでお聞きした、組織シート、こちらは今回は5600件程度ですので1万件もあればじゅうぶんです。
次に会社シート、こちらは今回は18万件ほどですので最初の設定は20万件にしています。列は66列あります。
次の組織シートは26万件ほどありますので最初の設定は30万件にしていました。
こちらは26万件ほどあるのですが列が11列なのでまだ早いのかな？と思ってはいるのですが、なぜかうまく表示されません。。。
最後のシートは20万件ほどなのですが2列しかないので今回のコードは使用していません。
 
私もこんな大量データをExcelでするのは気が引けるのですが、
Suzuさんのアドバイスで一度試してみます。
 
本当にありがとうございます。

>行と列を入れ替える作業がここにきてまた元に戻っている？
 
何をみて戻っている
と判断？しているんですか？

ありがとうございます。
 

With wsSoshiki '組織シート

    i = 0

    ReDim B(10, i)
    FNO = FreeFile
    Open strFilePath3 For Input As #FNO '組織.csvパス名を開く
        Do Until EOF(FNO)
            Line Input #FNO, buf
            A = Split(buf, ",")

            ReDim Preserve B(10, i)

            For j = LBound(A) To UBound(A)
                B(j, i) = A(j)
            Next j
            i = i + 1 '2行目から開始
        Loop
    Close #FNO
Stop
    B = WorksheetFunction.Transpose(B)

    .Range("A5").Resize(UBound(B), UBound(B, 2)) = B

'    .Range("A5").Resize(300000, 11) = B

End With

VBAで使用する班列操作関数には、横配列の要素数に制限があるようです。
Transposeも含まれます。
こちらで、300000件x10列でテストの結果
判明しました。
横配列要素数の制限は、65536です。
今回の場合、横配列要素数は、260000とはるかにオーバーしているため、
実行結果が保証されません。
 
Transposeの制限として、Nullデータはダメだというのは知っていましたが、
件数制限（横配列要素数）は、知りませんでした。
今迄、これほどの件数を扱ったことがなかったので、
何気なくアドバイスしてしまいました。
申し訳ありませんでした。、
Suzuさんのレスにあるように
QueryTables
をお勧めします。

いえいえ、そんなそんな！！
WinArrowさんに教えてもらった行列を入れ替える作業は私の中ではすごい発見でとても感謝しています。
ありがとうございます。
 
ではたまたま別シートでは数的にOKだったということなんですね。
それも勉強になりました。
 
Suzuさんに教えていただいた　QueryTables　でやってみます。
数が多い会社シートで実行したのですがセル幅が自動的に変わってしまったりして今試行錯誤しています。（＾＾；）
 
 
また報告させていただきます。

引用:
数が多い会社シートで実行したのですがセル幅が自動的に変わってしまったりして今試行錯誤しています。

Suzuさん
ありがとございます！！
 

With wsKihon.QueryTables.Add(Connection:="text;" & strFilePath1, Destination:=wsKihon.Range("$A$6")) '基本シート

    .AdjustColumnWidth = False
    .TextFilePlatform = 932
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
                                        2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
    .Refresh BackgroundQuery:=False
               
End With

With wsKihon

'    .Columns("A").ColumnWidth = 23.5
'    .Columns("B").ColumnWidth = 39.5
'    .Columns("C").ColumnWidth = 41.5
'    .Columns("D").ColumnWidth = 12.5
'    .Columns("E:AT").ColumnWidth = 7
'    .Columns("AU").ColumnWidth = 29.5
'    .Columns("AV:AY").ColumnWidth = 7
'    .Columns("AZ:BI").ColumnWidth = 12.5
'    .Columns("BJ:BN").ColumnWidth = 7

    r = 0
    
    r = .Range("A1").CurrentRegion.Rows.Count
    
    For j = 4 To 86
        .Cells(5, j) = WorksheetFunction.CountA(.Range(.Cells(6, j), .Cells(r, j))) '列のカウント
    Next j

End With