粗茶でございます日本語 プログラミング 言語 「なでしこ」 大好き 

このページの記事目次 (カテゴリー: Excel

スポンサーサイト

   ↑  --/--/-- (--)  カテゴリー: スポンサー広告
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

(記事編集) http://nadesocha.blog.fc2.com/?overture" target="_new

--/--/-- | Comment (-) | ホーム | ↑ ページ先頭へ ↑ |

Excel VBA 構造体を使った二次元配列

   ↑  2013/01/31 (木)  カテゴリー: Excel
 前回は、VBAで動的二次元配列の作成を紹介しましたが、今回は構造体を使った動的二次元配列の作成方法です。

Option Explicit

'========================================
' 構造体を使った動的二次元配列の作成
'========================================

'列用の配列を作る
Type typeCol
col() As Long
End Type

'行用の配列に列用の配列を入れる
Private row() As typeCol

Public Sub testSample()
Dim idx_row As Long, idx_col As Long
'配列の要素数を仮に宣言しておく
'行と列は別々に宣言する
ReDim row(0)
ReDim row(0).col(0)

For idx_row = 0 To 9
'行の要素数を増やす
'この時点では列の要素数は未定
ReDim Preserve row(idx_row)
For idx_col = 0 To 9
'列の要素数を増やす
ReDim Preserve row(idx_row).col(idx_col)
'配列の指定はArray(x,y)ではなく、
'Array_row(x).Array_col(y)のようになる
row(idx_row).col(idx_col) = idx_row + idx_col
Next idx_col
Next idx_row

For idx_row = 0 To 9
For idx_col = 0 To 9
Cells(idx_row + 1, idx_col + 1) = row(idx_row).col(idx_col)
Next idx_col
Next idx_row
End Sub


result20130131.gif
実行結果


スポンサーサイト

この記事に含まれるtag : Excel VBA 

FC2スレッドテーマ : プログラミング (ジャンル : コンピュータ

(記事編集) http://nadesocha.blog.fc2.com/blog-entry-165.html

2013/01/31 | Comment (1) | Trackback (0) | ホーム | ↑ ページ先頭へ ↑ |

ExcelVBA 二次元配列の行数を動的に変更する

   ↑  2013/01/01 (火)  カテゴリー: Excel
 動的配列を使えば、配列の要素数が増減しても、配列を再定義することで対応できます。
 しかし、二次元配列の場合は少し面倒なことがあります。それは、要素数を変更できるのは2次元目だという点です。

 そこで、二次元配列の1次元目の要素数を変更する関数を作成しました。
 解説は気が向いたらここに追記します。

Option Explicit

Public Sub ArraySample()

Dim myArray As Variant, addArray As Variant
Dim idx_i As Long, idx_j As Long

ReDim myArray(9, 4) '10行5列の2次元配列を宣言
For idx_i = 0 To 9
For idx_j = 0 To 4
'配列に適当なデータを設定
myArray(idx_i, idx_j) = idx_i * 10 + idx_j
Next idx_j
Next idx_i

'5行目にデータを追加
ReDim addArray(4)
For idx_i = 0 To 4
addArray(idx_i) = idx_i + 1000
Next idx_i
Array_Add myArray, addArray, 5

'8行目のデータを削除
Array_Del myArray, 8

'結果をシートに出力
Range(Cells(1, 1), Cells(UBound(myArray, 1) + 1, _
UBound(myArray, 2) + 1)) = myArray

End Sub

Public Sub Array_Add(ByRef inArray As Variant, _
ByVal inValue As Variant, Optional ByVal inRow As Variant)

Dim tmpArray As Variant
Dim idx_tmp As Long
Dim idx_i As Long, idx_j As Long

'inRowは挿入位置
If IsMissing(inRow) Then inRow = UBound(inArray, 1) + 1

'現在の配列内容をコピー
tmpArray = inArray

'配列を再定義
ReDim inArray(UBound(inArray, 1) + 1, UBound(inArray, 2)) '1行追加

'tmpArrayの内容を戻す
idx_tmp = LBound(tmpArray, 1)
For idx_i = LBound(inArray, 1) To UBound(inArray, 1)
If idx_i = inRow Then
'挿入位置にデータを追加
For idx_j = LBound(inValue) To UBound(inValue)
inArray(idx_i, idx_j) = inValue(idx_j)
Next idx_j
Else
'挿入位置でなければそのまま戻す
For idx_j = LBound(tmpArray, 2) To UBound(tmpArray, 2)
inArray(idx_i, idx_j) = tmpArray(idx_tmp, idx_j)
Next idx_j
idx_tmp = idx_tmp + 1
End If
Next idx_i

End Sub

Public Sub Array_Del(ByRef inArray As Variant, _
Optional ByVal inRow As Variant)

Dim tmpArray As Variant
Dim idx_tmp As Long
Dim idx_i As Long, idx_j As Long

'inRowは削除位置
If IsMissing(inRow) Then inRow = UBound(inArray, 1)

'現在の配列内容をコピー
tmpArray = inArray

'配列を再定義
ReDim inArray(UBound(inArray, 1) - 1, UBound(inArray, 2)) '1行削除

'tmpArrayの内容を戻す
idx_tmp = LBound(tmpArray, 1)
For idx_i = LBound(tmpArray, 1) To UBound(tmpArray, 1)
If idx_i <> inRow Then
'削除位置でなければそのまま戻す
For idx_j = LBound(tmpArray, 2) To UBound(tmpArray, 2)
inArray(idx_tmp, idx_j) = tmpArray(idx_i, idx_j)
Next idx_j
idx_tmp = idx_tmp + 1
End If
Next idx_i

End Sub


ArraySampleの実行結果
実行結果


この記事に含まれるtag : Excel VBA 

FC2スレッドテーマ : プログラミング (ジャンル : コンピュータ

(記事編集) http://nadesocha.blog.fc2.com/blog-entry-164.html

2013/01/01 | Comment (0) | Trackback (0) | ホーム | ↑ ページ先頭へ ↑ |

エクセルでデータの最終行や最右列などを調べる

   ↑  2012/04/30 (月)  カテゴリー: Excel
 Excelで、データの数が決まってないとき、どこまでデータが入力されているのか調べる必要があります。
 任意のセルから下の方に空白セルが見つかるまでひとつずつデータがあるか調べたり、終端を示すデータ行まで調べたりしますが、いつも似たようなコードを書くのが面倒なので、関数をつくってみました。

 サンプルのExcelファイルはこちらからダウンロードして下さい。

Function エクセルセル表先頭行取得(ByVal myCell As String) As Long
エクセルセル表先頭行取得 = Range(myCell).CurrentRegion.Row
End Function

Function エクセルセル表末尾行取得(ByVal myCell As String) As Long
Dim myRange As Range
Dim maxRow As Long
Set myRange = Range(myCell).CurrentRegion
maxRow = myRange.Rows.Count
エクセルセル表末尾行取得 = myRange.Cells(maxRow, 1).Row
End Function

Function エクセルセル表左列取得(ByVal myCell As String) As String
Dim Result As String
Dim myRange As Range
Dim myCol_Number As Long
Dim myCol_Address As String
Dim myAdd As String
Set myRange = Range(myCell).CurrentRegion
myCol_Number = myRange.Column '列を数値で示す
myAdd = myRange.Columns(1).Address(True, False)
myCol_Address = Left(myAdd, InStr(myAdd, "$") - 1) '列を文字で示す
' Result = myCol_Number & vbCrLf & myCol_Address
Result = myCol_Number
エクセルセル表左列取得 = Result
End Function

Function エクセルセル表右列取得(ByVal myCell As String) As String
Dim Result As String
Dim myRange As Range
Dim myCol_Number As Long
Dim myCol_Address As String
Dim myAdd As String
Dim maxCol As Long
Set myRange = Range(myCell).CurrentRegion
maxCol = myRange.Columns.Count
myCol_Number = myRange.Cells(1, maxCol).Column '列を数値で示す
myAdd = myRange.Columns(maxCol).Address(True, False)
myCol_Address = Left(myAdd, InStr(myAdd, "$") - 1) '列を文字で示す
' Result = myCol_Number & vbCrLf & myCol_Address
Result = myCol_Number
エクセルセル表右列取得 = Result
End Function

Function エクセルセル先頭行取得(ByVal myCell As String) As Long
Dim myRange As Range
Dim myRow As Long
Set myRange = Range(myCell & "1")
If myRange.Value = "" Then
myRow = myRange.End(xlDown).Row
Else
myRow = 1
End If
エクセルセル先頭行取得 = myRow
End Function

Function エクセルセル末尾行取得(ByVal myCell As String) As Long
Dim myRange As Range
Dim myRow As Long
Set myRange = Range(myCell & Rows.Count)
If myRange.Value = "" Then
myRow = myRange.End(xlUp).Row
Else
myRow = Rows.Count
End If
エクセルセル末尾行取得 = myRow
End Function

Function エクセルセル左列取得(ByVal myCell As Long) As String
Dim Result As String
Dim myRange, leftRange As Range
Dim myCol_Number As Long
Dim myCol_Address As String
Dim myAdd As String
Set myRange = Range("A" & myCell)
If myRange.Value = "" Then
Set leftRange = myRange.End(xlToRight)
myCol_Number = leftRange.Column '列を数値で示す
myAdd = leftRange.Columns(1).Address(True, False)
myCol_Address = Left(myAdd, InStr(myAdd, "$") - 1) '列を文字で示す
' Result = myCol_Number & vbCrLf & myCol_Address
Result = myCol_Number
Else
' Result = "1" & vbCrLf & "A"
Result = "1"
End If
エクセルセル左列取得 = Result
End Function

Function エクセルセル右列取得(ByVal myCell As Long) As String
Dim Result As String
Dim myRange, rightRange As Range
Dim myCol_Number As Long
Dim myCol_Address As String
Dim myAdd As String
Set myRange = Cells(myCell, Columns.Count)
If myRange.Value = "" Then
Set rightRange = myRange.End(xlToLeft)
myCol_Number = rightRange.Column '列を数値で示す
myAdd = rightRange.Columns(1).Address(True, False)
Else
myCol_Number = Columns.Count '列を数値で示す
myAdd = myRange.Address(True, False)
End If
myCol_Address = Left(myAdd, InStr(myAdd, "$") - 1) '列を文字で示す
' Result = myCol_Number & vbCrLf & myCol_Address
Result = myCol_Number
エクセルセル右列取得 = Result
End Function

Function エクセルセル表エリア取得(ByVal myCell As String) As String
Dim Result As String
Result = エクセルセル表先頭行取得(myCell) & "," & _
エクセルセル表左列取得(myCell) & "," & _
エクセルセル表末尾行取得(myCell) & "," & _
エクセルセル表右列取得(myCell)
'左上のrow,col,右下のrow,col
エクセルセル表エリア取得 = Result
End Function

Function エクセルセル表サイズ取得(ByVal myCell As String) As String
Dim myRange As Range
Set myRange = Range(myCell).CurrentRegion
'行数,列数
エクセルセル表サイズ取得 = myRange.Rows.Count & "," & myRange.Columns.Count
End Function


・エクセルセル表先頭行取得
 任意のセルを含むデータ領域の先頭行番号を数値で返します。
・エクセルセル表末尾行取得
 任意のセルを含むデータ領域の末尾行番号を数値で返します。
・エクセルセル表左列取得
 任意のセルを含むデータ領域の左端列番号を数値で返します。
・エクセルセル表右列取得
 任意のセルを含むデータ領域の右端列番号を数値で返します。
・エクセルセル先頭行取得
 任意の列で先頭にあるデータの行番号を数値で返します。
・エクセルセル末尾行取得
 任意の列で末尾にあるデータの行番号を数値で返します。
・エクセルセル左列取得
 任意の行で左端にあるデータの列番号を数値で返します。※文字で返すこともできます。
・エクセルセル右列取得
 任意の行で右端にあるデータの列番号を数値で返します。※文字で返すこともできます。
・エクセルセル表エリア取得
 任意のセルを含むデータ領域の左上セルの行番号と列番号と右下セルの行番号と列番号を数値で返します。
・エクセルセル表サイズ取得
 任意のセルを含むデータ領域の行数と列数を数値で返します。

 実際の動作は、サンプルファイルにあるマクロ「Test_All」を実行してみてください。

 これをベースにして、なでしこ2.0のエクセルプラグインをつくっていきます。
 うーん、もうちょっとスマートにできると思うので、実装するときは改良する必要がありますね。

この記事に含まれるtag : Excel VBA 

FC2スレッドテーマ : プログラミング (ジャンル : コンピュータ

(記事編集) http://nadesocha.blog.fc2.com/blog-entry-145.html

2012/04/30 | Comment (0) | Trackback (0) | ホーム | ↑ ページ先頭へ ↑ |

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。