Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2013)
1-6等が1月6日に変わってしまう
投稿日時: 20/12/02 10:24:05
投稿者: vaioyuki

いつもお世話になっています。
単純なことなのかもしれませんが理解が乏しく悩んでいます。
 
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」で表示されるのですが、
そうすると5行目のCountAが前セルカウントしてしまいます。
 
元々のセルの設定は 標準 です。
 
よろしくお願いします。

投稿日時: 20/12/02 10:29:44
投稿者: vaioyuki

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

回答
投稿日時: 20/12/02 11:56:31
投稿者: Suzu

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

 
改善を行いたい点として
・「1-6」を 値としたい
      → 値を入れる前に、セルの書式を文字列とする
   → 値を入れる際に、プレフィックスとして「'」を与える
 
・「1-6」を 表示したい
   → 値を入れる際に、先頭にスペースを加える
   → 値としては、日付データとなっているので、セルの書式を「y-d」とする
 
ここまでは、VBAに限らず Excelの ありがた迷惑(?)でもある機能であり 一般機能でも一緒ですね。
設定等で OFFにする事もできません。
 
 
 
良く判らないのですが、COUNTA 関数なのであれば
1-6 が 文字列、日付 どちらとも、計算対象としなりますよね?
COUNT関数 と 勘違いされていますか?

投稿日時: 20/12/02 13:53:55
投稿者: vaioyuki

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

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

 
こちらでCountAで計算しているのですが、
セルの設定を文字列にすると、
CountA独特の空白ではなく貼り付けた時点で空白でも長さ0の文字列としてカウントされているようです。
 
VBA上ではなく、
実際にExcelにCountA関数を入力しても空白までもがカウントされます。(;▽;)
 

回答
投稿日時: 20/12/02 14:49:36
投稿者: WinArrow
投稿者のウェブサイトに移動

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

投稿日時: 20/12/02 15:06:00
投稿者: vaioyuki

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

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

 
こちらに変更してみました。
すると、空白としてみられるセルはカウントしなくなったのですが、
「●」と「あり」のように記号と日本語が混じっている行は「●」しかカウントされなくなりました。
 
ますますわからなくなりました。。。

回答
投稿日時: 20/12/02 15:15:37
投稿者: WinArrow
投稿者のウェブサイトに移動

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

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  ' ★


 
※ #1 ではなく FNO = FreeFile のようにアイル番号をつかいましょう。
 
 
 
 

回答
投稿日時: 20/12/02 15:40:22
投稿者: WinArrow
投稿者のウェブサイトに移動

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

投稿日時: 20/12/02 16:54:50
投稿者: vaioyuki

WinArrow さんの引用:

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

 
ありがとうございます。
これ、実はデータ数固定ではないのですがどうやって変えたらいいかわからず、
色々検索してデータ件数をわざと多めにして設定しました。
 
やってみます!!
また報告させて頂きます。

回答
投稿日時: 20/12/02 17:15:01
投稿者: WinArrow
投稿者のウェブサイトに移動

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

回答
投稿日時: 20/12/02 17:21:44
投稿者: WinArrow
投稿者のウェブサイトに移動

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

回答
投稿日時: 20/12/02 17:33:50
投稿者: Suzu

問題は、
セルの書式を文字列に指定した場合、
空白のはずのセルが、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」を入れ込む列の書式を文字列に変え
     現状と同じ様に読み込む手も。。

投稿日時: 20/12/02 17:35:17
投稿者: vaioyuki

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

投稿日時: 20/12/04 15:02:10
投稿者: vaioyuki

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

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

 
教えてもらってこのように記述したのですが、
15分経っても作業が終了しません。。。
 
別で同じような作業をしますのでやってみたらうまく取り入れてくれたのでコード的には問題ないかと思うのですが。。。
 
ちなみに、
うまくいったデータ件数は5685件、今回の会社シートは183361件あります。
 
最初と最後には
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
・
・
・
・
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 
は入れています。
 
 
以前はこんなに時間がかかることがなかったのですが何が原因なんでしょうか???

投稿日時: 20/12/04 16:25:04
投稿者: vaioyuki

追記です。
別問題が出ました。(^^;)
 
同じようにしているのですが、全く違うもの。。。というか、順番?が違って貼付されます。
元のデータは下記になります。(一部、ユーザコードがありますので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

 
すると結果が、
 
10380    WFUSER    xxx-jun    xxx-hru    xxx_XXXXXX    xxx-tkh    xxx-shu    xxx-say    xxx-aki    xxx-nob    xxx-jni    
10380    WFUSER    xxx-jun    xxx-hru    xxx_XXXXXX    xxx-tkm    xxx-shu    fukui-say    xxx-aki    xxx-nob    xxx-jni    
10380    WFUSER    xxx-jun    xxx-hru    xxx_XXXXXX    xxx-tkm    xxx-shu    fukui-say    xxx-aki    xxx-nob    xxx-jni    
10380    WFUSER    xxx-jun    xxx-hru    xxx_XXXXXX    xxx-tkm    xxx-shu    fukui-say    xxx-aki    xxx-nob    xxx-jni    
 
最初のユーザコードだけがA列から記載され、
3500行あたりでB列に移動してまたユーザコードが記載されているようになっています。
 
他のシートと違うところは、列数が少ない(10列)、A5から貼付なのですがそれで問題になっているのでしょうか。。。(´;ω;`)ウゥゥ

回答
投稿日時: 20/12/04 20:02:28
投稿者: WinArrow
投稿者のウェブサイトに移動

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

回答
投稿日時: 20/12/04 21:06:14
投稿者: WinArrow
投稿者のウェブサイトに移動

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

回答
投稿日時: 20/12/07 12:15:13
投稿者: Suzu

読み込み全数に対し、配列を組みなおしたりしているので、遅くて当然です。
 
物は試しで
外部データの取込を試してみてはいかがでしょう?
(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経由で絞込みますね。

投稿日時: 20/12/07 15:36:04
投稿者: vaioyuki

たくさんのアドバイス、ありがとうございます。
 
まずは配列がおかしくなる?ものからみてみました。
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)

 
ここを過ぎると B をローカルウィンドウで見てみると、
 
B(1)
 B(1.1) "10380"
 B(1.2) "WFUSER"
 B(1.3) "xxx-jun"
 ・
 ・
 ・
 B(1.10) "xxx-nob"
 B(1.11) "xxx-jni"
B(2)
 B(2.1) "10380"
 B(2.2) "WFUSER"
 B(2.3) "xxx-jun"
 ・
 ・
 ・
 B(2.10) "xxx-nob"
 B(2.11) "xxx-jni"
 
のような配列になってしまいました。
 
最後は
 
 B(3563.11) "XXX-syo"
 
で終わっているのでここで3563行までしかいかずにどうも最初に教えていただいた、行と列を入れ替える作業がここにきてまた元に戻っている?
 
他のシートではうまくいけてるのになぜこのシートだけ?
 
何度も見返して同じコードを書いているとは思うのですが、
列数が違う、貼付する位置が違うだけなのですが何が原因なんでしょう。。。

投稿日時: 20/12/07 15:50:38
投稿者: vaioyuki

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

回答
投稿日時: 20/12/07 18:32:08
投稿者: WinArrow
投稿者のウェブサイトに移動

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

投稿日時: 20/12/08 13:21:02
投稿者: vaioyuki

ありがとうございます。
 

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

 
Close #FNO のあとにSTOPかけると、
それまでの B をプロシージャで確認すると、
 
B(0)
 B(0.0) "10380"
 B(0.1) "10380"
 ・
 ・
 ・
 B(0.265705) "xxx-mas"
 B(0.265706) "xxx-mas"
B(1)
 B(1.0) "000000"
 B(1.1) "000001"
 ・
 ・
 ・
 B(1.265705) "000123"
 B(1.265706) "000123"
 
のようにきちんと B に格納しているのですが、次のステップ(B = WorksheetFunction.Transpose(B))に移動したら B(0) がなくなり、
 
B(1)
 B(1.1) "10380"
 B(1.2) "WFUSER"
 B(1.3) "xxx-jun"
 ・
 ・
 ・
 B(1.10) "xxx-nob"
 B(1.11) "xxx-jni"
B(2)
 B(2.1) "10380"
 B(2.2) "WFUSER"
 B(2.3) "xxx-jun"
 ・
 ・
 ・
 B(2.10) "xxx-nob"
 B(2.11) "xxx-jni"
 
のように1列のデータだけしかなくなりました。
行と列が入れ替わる。。。という言い方は間違っているかもしれませんが、
データとしては1列目しか残らなくなり、なぜかこの場合だと3563行読み込んだ後に次の列に移動してまた元データの1列目を表示するような症状になっています。

回答
投稿日時: 20/12/08 15:31:34
投稿者: WinArrow
投稿者のウェブサイトに移動

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

投稿日時: 20/12/08 16:08:41
投稿者: vaioyuki

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

回答
投稿日時: 20/12/08 17:21:13
投稿者: Suzu

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

 
QueryTableオブジェクトの AdjustColumnWidth プロパティ
https://docs.microsoft.com/ja-jp/office/vba/api/excel.querytable.adjustcolumnwidth
 
判りづらい日本訳になっていますが、Falseを渡せば 自動的に幅を調整する機能をOffにできます。

投稿日時: 20/12/09 10:10:38
投稿者: vaioyuki

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


 
コメントオフしてますが、ひとつずつ設定していましたw。( ;∀;)
助かりました!!
 
こちらでやってみます。
 
長々とありがとうございました。