投稿/コメントを表示します。

エクセルマクロ・VBA導入編
エクセルマクロ・VBAを利用するための推奨設定 - イントロダクション

受講生さんの投稿

(投稿ID: 3149)

発展編２　練習問題：配列

まだ問題４までですができてますか？
なんかスマートに言ってないような気がしてます。
考え方はあっていますか？
ご指導、よろしくお願いします。
Option Explicit
    
    Dim aMx As Long
    Dim cMx As Long
    Dim cnt As Long
Function GyoData() As String()
    
    Dim s() As String

'    Erase s  '←　配列の初期化が必要かと思ったが…

'    s() = Split(Range("A2").Value, ",") ' 問題１の時
    s() = Split(Range("A" & cnt).Value, ",")  '問題２～
    
    GyoData = s

End Function
Sub Mondai1()
    
    '2017/05/28～やってみよう
    
    
    '練習問題 配列
    '問題１
    
    Dim Data() As String
    Dim c As Long
    
    
    
    
    Data() = GyoData()
    For c = LBound(Data) To UBound(Data)
        Range("F2").Offset(, c).Value = Data(c)
    Next
    
    
End Sub
Sub Mondai2()
    
    '2017/05/28～やってみよう
    
    
    '練習問題 配列
    '問題２
    
    Dim Data() As String
    Dim c As Long
    
    aMx = Range("A" & Rows.Count).End(xlUp).Row
    
    For cnt = 2 To aMx
        Data() = GyoData()
        For c = LBound(Data) To UBound(Data)
            Range("F" & cnt).Offset(, c).Value = Data(c)
        Next
    Next
    
    
    
    
End Sub
Sub Mondai3()
    
    '2017/05/28～やってみよう
    
    
    '練習問題 配列
    '問題３
    
    Dim Data() As String
    Dim c As Long
    
    aMx = Range("A" & Rows.Count).End(xlUp).Row
    
    For cnt = 2 To aMx
        Data() = GyoData()
        cMx = Range("C" & Rows.Count).End(xlUp).Row + 1
        For c = LBound(Data) To UBound(Data)
            Range("C" & cMx).Offset(c).Value = Data(c)
        Next
    Next
    
End Sub
Sub Mondai4()
    
    '練習問題 配列
    '問題４
    
    Dim c As Long
    Dim cnt As Long
    Dim stList() As String
    Dim s As String
    Dim B As Boolean
    
    cMx = Range("C" & Rows.Count).End(xlUp).Row + 1
    
'配列に入れる処理

    For cnt = 2 To cMx
        
        B = False
        
        s = Range("C" & cnt).Value
        If cnt = 2 Then
            ReDim Preserve stList(cnt - 2)
            stList(cnt - 2) = s
        End If
        
        For c = LBound(stList) To UBound(stList)
            If s = stList(c) Then
                Debug.Print "ある時の処理"
                B = True
                Exit For
            End If
        Next
            
            
            
        If B = False Then
            Debug.Print "ない時の処理"
            ReDim Preserve stList(UBound(stList) + 1)
            stList(UBound(stList)) = s
        End If
    Next
'-----------------------------------------------------------
'配列の書き出し
    
    Dim r As Range
    
    
    For c = LBound(stList) To UBound(stList)
        
        For Each r In Range("F2:L99")
            If r.Value = stList(c) Then
                r.ClearContents
            End If
        Next
        
        
        
        Range("E" & c + 2).Value = stList(c)
    Next
 
 
 '2017/06/04 出来たけどスマートじゃない（。。；
    
End Sub

2017/06/06 08:28