Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5141 / 76732 ←次へ | 前へ→

【77204】Re:配列の有効数を求める(空白がある)
発言  β  - 15/6/16(火) 10:23 -

引用なし
パスワード
   ▼まり さん:

仮に ↑ のような要件であれば、以下のCompressArrayは配列を与え、その中の、完全空白列や
完全空白行を取り除き、小さな配列にするコードです。


Testでは、A1:F20 にあるデータを配列に入れ、それを圧縮して、H1 からの領域に落とし込んでいます。

Sub Test()  '空白行列の圧縮
  Dim v As Variant
  
  v = Range("A1:F20").Value  'テストデータ
  v = CompressArray(v, xlByColumns)
  v = CompressArray(v, xlByRows)
  
  MsgBox "有効行数:" & UBound(v, 1) & vbLf & "有効桁数:" & UBound(v, 2)
  
  Range("H1:M20").ClearContents
  Range("H1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  
End Sub

Function CompressArray(vnt As Variant, Optional by As XlSearchOrder = xlByRows) As Variant '空白列の圧縮
  'xlByRows  空白行を圧縮
  'xlByColumns 空白列を圧縮
  Dim t() As Variant
  Dim x As Long
  Dim y As Long
  Dim cnt As Long
  Dim pos As Long
  Dim v As Variant
  
  v = vnt
  If by = xlByRows Then v = WorksheetFunction.Transpose(v)
    
  ReDim t(0 To UBound(v, 2) - 1)
  pos = 0
  For y = 1 To UBound(v, 2)
    cnt = 0
    For x = 1 To UBound(v, 1)
      If Len(v(x, y)) > 0 Then Exit For
      cnt = cnt + 1
    Next
    If cnt <> UBound(v, 1) Then  '空白列
      t(pos) = y
      pos = pos + 1
    End If
  Next
  
  If pos = 0 Then
    CompressArray = vnt
  Else
    ReDim Preserve t(0 To pos - 1)
    CompressArray = Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), t)
  End If
  
  If by = xlByRows Then CompressArray = WorksheetFunction.Transpose(CompressArray)

End Function

285 hits

【77197】配列の有効数を求める(空白がある) まり 15/6/15(月) 17:18 質問[未読]
【77198】Re:配列の有効数を求める(空白がある) kanabun 15/6/15(月) 17:57 発言[未読]
【77199】Re:配列の有効数を求める(空白がある) まり 15/6/15(月) 20:28 質問[未読]
【77200】Re:配列の有効数を求める(空白がある) kanabun 15/6/15(月) 22:38 発言[未読]
【77201】Re:配列の有効数を求める(空白がある) kanabun 15/6/15(月) 23:17 発言[未読]
【77203】Re:配列の有効数を求める(空白がある) β 15/6/16(火) 10:09 発言[未読]
【77204】Re:配列の有効数を求める(空白がある) β 15/6/16(火) 10:23 発言[未読]
【77207】Re:配列の有効数を求める(空白がある) まり 15/6/17(水) 11:00 お礼[未読]
【77208】Re:配列の有効数を求める(空白がある) kanabun 15/6/17(水) 12:56 発言[未読]
【77213】Re:配列の有効数を求める(空白がある) まり 15/6/17(水) 18:11 回答[未読]
【77214】Re:配列の有効数を求める(空白がある) kanabun 15/6/17(水) 18:20 発言[未読]

5141 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free