Excel VBA質問箱 IV

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

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


968 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【77197】配列の有効数を求める(空白がある)
質問  まり  - 15/6/15(月) 17:18 -

引用なし
パスワード
   お世話になっております。

シートを配列化→データ抽出→フォーマットシートに転記

上記をしたいのですが、以下のvbaでは空白を含むシートの場合
対応できません。
空白を含む場合でも正常動作するにはどうすればよいですか。
B列は必ず値が入っております。

説明不足かもしれませんが、追記もしますので、
宜しくお願いします。


'配列の有効列数を求める
Public Function ArrayColumn(ArrayData As Variant) As Double

Dim i As Double

For i = 1 To UBound(ArrayData, 2)
  If ArrayData(1, i) = "" Then
   ArrayColumn = i - 1
   Exit For
  End If
Next

If ArrayColumn = 0 Then
  ArrayColumn = UBound(ArrayData, 2)
End If

End Function

'配列の有効行数を求める
Public Function ArrayRow(ArrayData As Variant) As Double

Dim i As Double

For i = 1 To UBound(ArrayData, 1)
  If ArrayData(i, 1) = "" Then
   ArrayRow = i - 1
   Exit For
  End If
Next

If ArrayRow = 0 Then
  ArrayRow = UBound(ArrayData, 1)
End If

End Function

【77198】Re:配列の有効数を求める(空白がある)
発言  kanabun  - 15/6/15(月) 17:57 -

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

>シートを配列化→データ抽出

>B列は必ず値が入っております。
>
有効列数を求める関数 ArrayColumn
有効行数を求める関数 ArrayRow
ともに、ArrayData という名の配列を送っていますが、
この配列はシートの範囲を配列にしたものではないのですか?
もしそうだとしたら、いま、どのようなコードで範囲を配列に入れていますか?


あと、別件で、

データ型に注意しましょう。
以下は2つとも Double ではなく、 Long型整数で十分ですよ

>Public Function ArrayColumn(ArrayData As Variant) As Double

>Dim i As Double

【77199】Re:配列の有効数を求める(空白がある)
質問  まり  - 15/6/15(月) 20:28 -

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

>ともに、ArrayData という名の配列を送っていますが、
>この配列はシートの範囲を配列にしたものではないのですか?
仰るとおり、シート範囲を配列にしたものです。

>もしそうだとしたら、いま、どのようなコードで範囲を配列に入れていますか?
'配列をシートに書き込む
Public Sub Array2Sheet(ArrayData As Variant, BookName As String, SheetName As String)

Dim RowNum As Double
Dim ColNum As Double

RowNum = ArrayRow(ArrayData)
ColNum = ArrayColumn(ArrayData)

With Workbooks(BookName).Sheets(SheetName)
  .Cells.Clear
  .Range(.Cells(1, 1), .Cells(RowNum, ColNum)) = ArrayData
End With

End Sub


>データ型に注意しましょう。
>以下は2つとも Double ではなく、 Long型整数で十分ですよ
ご指摘ありがとうございます。

【77200】Re:配列の有効数を求める(空白がある)
発言  kanabun  - 15/6/15(月) 22:38 -

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

>仰るとおり、シート範囲を配列にしたものです。
>
>>もしそうだとしたら、いま、どのようなコードで範囲を配列に入れていますか?

>'配列をシートに書き込む
>Public Sub Array2Sheet(ArrayData As Variant, BookName As String, SheetName As String)
>

あ、いえ、お聞きしたのは

「シートのセル範囲を 配列に どのように取り込んでいるか?」

ということです。

たとえば、

ArrayData = Range("B1").Currentregion.Value

のような構文です。

【77201】Re:配列の有効数を求める(空白がある)
発言  kanabun  - 15/6/15(月) 23:17 -

引用なし
パスワード
   いまアクティブなシートの[B1]セルを含む表範囲を配列に入れ、
指定シートに貼り付ける...

イメージとして、こんな処理を想定しましたが、いかがでしょうか?

Public Sub tryA()
 Dim ArrayData As Variant
 
 '表範囲を配列に取り込む
 ArrayData = Range("B1").CurrentRegion.Value
 
 'このBookのSheet1に配列データを貼りつける
 ArrayToSheet ArrayData, ThisWorkbook.Worksheets("Sheet1")

End Sub

'配列データを指定ワークシートの[A1]セルから貼り付け
Public Sub ArrayToSheet(ArrayData As Variant, ws As Excel.Worksheet)
 Dim RowNum As Long
 Dim ColNum As Long
 
 RowNum = UBound(ArrayData, 1)
 ColNum = UBound(ArrayData, 2)
 
 With ws
   .UsedRange.Clear
   .Cells(1).Resize(RowNum, ColNum).Value = ArrayData
 End With

End Sub

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

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

おはようございます
アップされたコードでは、配列の1列目の最初の要素から値が連続して入っていて
どこかで空白要素があらわれれば、かりにそれ以降に値があってもそこで行のチェックは打ち切りうちきり。
列のチェックについても、1行目で同じ判定。
こんな流れですね?

やりたいことは、配列の1行全体が空白のものは【非有効】、どこなに何かしら値があれば【有効】。
列についても同様。

そういうことでしょうか?

【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

【77207】Re:配列の有効数を求める(空白がある)
お礼  まり  - 15/6/17(水) 11:00 -

引用なし
パスワード
   皆様へ

返答できておらず申し訳ありません。

回答を理解するのに時間がかかっております。
もう少し時間をください。

【77208】Re:配列の有効数を求める(空白がある)
発言  kanabun  - 15/6/17(水) 12:56 -

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


>回答を理解するのに時間がかかっております。
>もう少し時間をください。

了解です。

ただ、先だってのこちらからの質問にお返事もらうわけには
いきませんかね?

>「シートのセル範囲を 配列に どのように取り込んでいるか?」

たとえば、
(1) ArrayData = Range("A1:F20").Value

(2) ArrayData = Range("B1").CurrentRegion.Value

(3)

(1)のようなアドレス固定方式? あるいは (2)のように 表範囲指定方式?
それとも (1)とも (2)ともちがう方式?

【77213】Re:配列の有効数を求める(空白がある)
回答  まり  - 15/6/17(水) 18:11 -

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

>たとえば、
>(1) ArrayData = Range("A1:F20").Value
>
>(2) ArrayData = Range("B1").CurrentRegion.Value
>
(3)行列の最終行を取得して、基点から最終までの範囲です。

説明ができているか不安ですが、宜しくお願いします。

【77214】Re:配列の有効数を求める(空白がある)
発言  kanabun  - 15/6/17(水) 18:20 -

引用なし
パスワード
   ▼まり さん:
>▼kanabun さん:
>
>>たとえば、
>>(1) ArrayData = Range("A1:F20").Value
>>
>>(2) ArrayData = Range("B1").CurrentRegion.Value
>>
>(3)行列の最終行を取得して、基点から最終までの範囲です。
>
>説明ができているか不安ですが、宜しくお願いします。

ありがとうございます。
コードにすると、どういったものですか?

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