配列
　
　 　 Option Explicit

'--------------------------------------------------------
'ユーザー定義型
'--------------------------------------------------------
Public Type SyainData
Id As String
Name As String
End Type
Sub test()
Dim i As Long
Dim wrkSyainData() As SyainData
Call GetSyainData(wrkSyainData())
For i = 1 To 2
MsgBox wrkSyainData(i).Id & "-" & wrkSyainData(i).Name
Next i
End Sub

Function GetSyainData(ByRef prmSyainData() As SyainData)
Dim i As Long
ReDim prmSyainData(2)
prmSyainData(1).Id = "001"
prmSyainData(1).Name = "aaa"
prmSyainData(2).Id = "002"
prmSyainData(2).Name = "bbb"
End Function

'--------------------------------------------------------
'配列の受け渡し
'--------------------------------------------------------
Sub sample4()
Dim i As Long
Dim j As Long
Dim strTbl() As String
Erase strTbl()
j = 3
ReDim strTbl(j)
Call sample41(strTbl())
For i = 1 To UBound(strTbl())
MsgBox strTbl(i)
Next i
End Sub
Function sample41(prm() As String)
prm(1) = "001"
prm(2) = "002"
prm(3) = "003"
End Function

'--------------------------------------------------------
'配列をセルに代入する
'--------------------------------------------------------
Sub SampleA1()
Dim buf As String
buf = "田中" & vbCrLf & "鈴木" & vbCrLf & "山田"
Range("A1:C1") = Split(buf, vbCrLf)
End Sub
Sub SampleA2()
Dim buf As String
buf = "田中" & vbCrLf & "鈴木" & vbCrLf & "山田"
Range("A1:A3") = WorksheetFunction.Transpose(Split(buf, vbCrLf))
End Sub
Sub SampleA3()
Dim buf As String, tmp As Variant
With CreateObject("Scripting.FileSystemobject").GetFile("C:\ak\down\Sample.txt").OpenAsTextStream
buf = .ReadAll
.Close
End With
tmp = Split(buf, vbCrLf)
Range(Cells(1, 1), Cells(UBound(tmp), 1)) = WorksheetFunction.Transpose(tmp)
End Sub

'--------------------------------------------------------
'配列フィルター
'--------------------------------------------------------
Sub Sample3()
Dim strArray(4) As String
Dim strResult() As String

strArray(0) = "東京"
strArray(1) = "東京名古屋"
strArray(2) = "大阪"
strArray(3) = "京都"
strArray(4) = "名古屋"

strResult = Filter(strArray, "京", , vbTextCompare)

MsgBox Join(strResult, vbCrLf)
End Sub

'--------------------------------------------------------
'配列結合
'--------------------------------------------------------
Sub Sample2()
Dim strArray(2) As String
Dim strData As String

strArray(0) = "ABC"
strArray(1) = "DEF"
strArray(2) = "GHI"

strData = Join(strArray) & vbCrLf
strData = strData & Join(strArray, "") & vbCrLf
strData = strData & Join(strArray, "+")

MsgBox strData

End Sub

'--------------------------------------------------------
'数値と単位分解
'--------------------------------------------------------
Sub SeparateValue()
MsgBox getNum("1.2cm")
MsgBox getUnit("1.2cm")
End Sub

Function getNum(strPrm As String) As Variant
Dim dblVal As Double
dblVal = Val(strPrm)
getNum = dblVal
End Function

Function getUnit(strPrm As String) As Variant
Dim dblVal As Double
Dim strUnit As String
dblVal = Val(strPrm)
strUnit = Replace(strPrm, dblVal, "")
getUnit = strUnit
End Function

'--------------------------------------------------------
'区切り編集
'--------------------------------------------------------
Sub sample()
Dim i As Long
Dim strwk
strwk = Split("123,abc,あいうえお", ",")
For i = 0 To UBound(strwk)
MsgBox strwk(i)
Next i
End Sub

'--------------------------------------------------------
'[XL2002]配列を返す関数を作成する方法
'http://support.microsoft.com/kb/402326/ja
'--------------------------------------------------------
Function Sample1()
Dim i As Integer
Dim ret(0 To 9) As Integer '10 要素の整数型配列を宣言します。
For i = 0 To 9 '配列にダミーのデータを代入します。
ret(i) = i
Next
Sample1 = ret '配列名で配列を戻り値として指定します。
End Function

'--------------------------------------------------------
'配列転記　最小、最大　値求める
'--------------------------------------------------------
Option Explicit
Dim ST As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Dim varwk As Variant
Sub sample1()
'配列転記 ワーク→セル
Dim strwk(1 To 3, 1 To 4) As String ' 3×4の2次元配列
Set ST = Worksheets("Sheet2")
Worksheets(ST.Name).Activate
ST.Range("A1").CurrentRegion.Select
Selection.Clear
varwk = Array("A", "B", "C", "D")
For i = 1 To 3
For j = LBound(varwk) To UBound(varwk) '0 to 3
strwk(i, j + 1) = varwk(j) & i
Next j
Next i
'配列を転記
ST.Cells(1, 1).Resize(3, 4).Value = strwk
End Sub
Sub sample2()
'配列転記　セル
Set ST = Worksheets("Sheet2")
Worksheets(ST.Name).Activate
ST.Range("A1").CurrentRegion.Select
Selection.Clear
varwk = Array("A", "B", "C", "D")
For i = 1 To 3
For j = LBound(varwk) To UBound(varwk) '0 to 3
Cells(i, j + 1) = varwk(j) & i
Next j
Next i
End Sub
Sub sample3()
'最小、最大を求める
'MsgBox ActiveSheet.Name
Set ST = Worksheets("Sheet1")
Worksheets(ST.Name).Activate
ST.Range("A1").CurrentRegion.Select
Selection.Clear
varwk = Array("'6/20", "'12/2", "'06/01", "'12/11")
'varwk = Array("'5", "'3", "'6", "'4")
For i = LBound(varwk) To UBound(varwk) '0 to 3
ST.Cells(i + 1, 1) = varwk(i) 'sort文字列で並べ替え（日付には適していない）
ST.Cells(i + 1, 2) = varwk(i) 'sortなし
ST.Cells(i + 1, 3) = varwk(i) 'sortマクロ
ST.Cells(i + 1, 4) = Replace(varwk(i), "'", "") 'sort日付変換後であれば有効
Next i
i = i + 1
ST.Cells(i, 1) = "SORT有.Sort"
ST.Cells(i, 2) = "SORT無"
ST.Cells(i, 3) = "SORT有EXCEL"
ST.Cells(i, 4) = "SORT有.Sort"

ST.Range(Cells(1, 1), Cells(4, 1)).Sort Key1:=ST.Cells(1, 1), Order1:=xlAscending

ST.Range("C1:C4").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortTextAsNumbers

ST.Range("D1:D4").Select
Selection.NumberFormatLocal = "m""月""d""日"";@"
ST.Range(Cells(1, 4), Cells(4, 4)).Sort Key1:=ST.Cells(1, 4), Order1:=xlAscending

' Debug.Print Cells(1, 1).Value
' Debug.Print Cells(4, 1).Value
ST.Cells(1, 1).Select
End Sub


Sub a0()
''検索元の配列
'Dim ary As String() = New String() {"red", "blue", "white", "blue", "red"}
''"blue"の位置を取得する
'Dim index1 As Integer = Array.IndexOf(ary, "blue")
''"1"を返す
''"gold"の位置を取得する
'Dim index2 As Integer = Array.IndexOf(ary, "gold")
''存在しないので、"-1"を返す
'検索元の配列
Dim userAddress As Variant
userAddress = Array("東京都", "北海道", "愛知県")
If InStr(vbTab & Join(userAddress, vbTab) & vbTab, vbTab & "北海道" & vbTab) > 0 Then
MsgBox "北海道あり"
Else
MsgBox "北海道なし"
End If
If InStr(vbTab & Join(userAddress, vbTab) & vbTab, vbTab & "大阪府" & vbTab) > 0 Then
MsgBox "大阪府あり"
Else
MsgBox "大阪府なし"
End If
End Sub

Sub a1()
Dim strAddress As String
Dim strArray() As String
Dim strMsg As String
'---複数のセル範囲のアドレスを取得
strAddress = Application.InputBox( _
Prompt:="複数範囲を選択してください" & vbCr & "( [Ctrl] ＋ 範囲選択 )" _
, Type:=8).Address
'---(1)Split関数で配列に格納
strArray = Split(strAddress, ",")
'---(2)文字列"A"を含むアドレスだけを残す
strArray = Filter(strArray, "A", True)
'---(3)Join関数で配列からカンマ区切りの文字列に戻す
strAddress = Join(strArray, ",")
If strAddress = "" Then
MsgBox "A列を含む範囲はありませんでした"
Else
Range(strAddress).Select
MsgBox "A列を含むセル範囲 (" & strAddress & ") だけを選択しました"
End If
End Sub

Sub a2()
Dim i As Integer
Dim dArray() As String
ReDim Preserve dArray(3)
dArray(0) = "January"
dArray(1) = "February"
dArray(2) = "March"
dArray(3) = "April"
For i = 0 To UBound(dArray)
Debug.Print dArray(i)
Next
End Sub

Sub a3()
'Microsoft Scripting Runtime
Dim dict As Variant
Dim key As Variant
Dim data As Variant
Set dict = CreateObject("Scripting.Dictionary")
dict("name") = "鈴菜"
dict("sex") = "女"
dict("age") = 10
For Each key In dict
data = dict(key)
Debug.Print key & ": " & data
Next
Debug.Print "name: " & dict("name")
Debug.Print "sex: " & dict("sex")
Debug.Print "age: " & dict("age")
Set dict = Nothing
End Sub