VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日： 2003/09/04(Thu) 14:46
投稿者： よねＫＥＮ
Ｅメール：
ＵＲＬ：
タイトル： Re^2: まとめ方(1例)

元のコードの矛盾点は適当に解釈してまとめてみました。
机上で書いているので、コンパイルが通るかどうかはわかりません。
こういうまとめ方もできるという参考までに。

Private Function GetData(ByVal col As Long, ByVal row As Long, ByVal prevRowData As String) As String
    Dim data As String

    Select Case col
    Case 1
        data = "MW-25014"
    Case 2
        data = "M" & IncrementStr(prevRowData, 5)
    Case 3
        data = "200-240V"
    Case 4
        data = "NTSC"
    Case 5
        data = "3.1.0"
    Case 6
        data = "MFS-4000-24"
    Case 7
        data = "2003/05/14"
    Case 8
        data = "2003/05/16"
    Case 9
        data = "EP481200DD" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 10
        data = "EP443901FG" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 11
        data = "EP443901FG" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 12
        data = "EP444000FF" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 13
        data = "EP444100CE" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 14
        data = "EP444300BL" & " 25013/" &  IncrementStr(prevRowData, 3)
    Case 15
        data = "EP483700AA" & " 25013/" &  IncrementStr(prevRowData, 3)
    End Select

    GetData = data
End Function

Private Function IncrementStr(ByVal data As String, ByVal length As Long) As String
    Dim wk As Long

    wk = CLng(Right(data, length)) + 1
    IncrementStr = Right(String(length, "0") & data, length)
End Function

Public Sub Enter()
    Dim col As Long
    Dim row As Long
    
    col = ActiveCell.Column
    row = ActiveCell.Row

    If row > 2 Then
        Cells(row, col).Value = GetData(col, row, Cells(row - 1, col).Value)
    End If
    Cells(row, col + 1).Select

    Select Case col
    Case 12: ActiveCell.Characters(Start:=12, Length:=9).Font.Name = "Tahoma"
    Case 13: ActiveCell.Characters(Start:=1, Length:=10).Font.Name = "Tahoma"
    End Select
End Sub

- 関連一覧ツリー （★ をクリックするとツリー全体を一括表示します）
- 返信フォーム （この記事に返信する場合は下記フォームから投稿して下さい）

- Web Forum -