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

投稿日： 2003/09/04(Thu) 10:26
投稿者： MAI
ＵＲＬ：
タイトル： まとめ方

おはようございます。
こんな長いのをモジュールで書いてみました。
簡単にする方法はないでしょうか？
Public Sub Enter()
    Dim col As Long
    Dim row As Long
    Dim wk  As Long
    
    col = ActiveCell.Column
    row = ActiveCell.row
    
If (col = 1) Then
     If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "MW-25014"
     End If
        Cells(row, col + 1).Select
ElseIf (col = 2) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 5)) + 1
            Cells(row, col).Value = "M" & Format(CStr(wk), "00000")
        End If
            Cells(row, col + 1).Select
ElseIf (col = 3) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "200-240V"
         End If
            Cells(row, col + 1).Select
ElseIf (col = 4) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "NTSC"
         End If
            Cells(row, col + 1).Select
ElseIf (col = 5) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "3.1.0"
        End If
            Cells(row, col + 1).Select
ElseIf (col = 6) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "MFS-4000-24"
         End If
            Cells(row, col + 1).Select
ElseIf (col = 7) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "2003/05/14"
         End If
            Cells(row, col + 1).Select
ElseIf (col = 8) Then
        If (row > 2) Then
            Cells(row, col).Value = Cells(row - 1, col).Value
            Cells(row, col).Value = "2003/05/16"
         End If
            Cells(row, col + 1).Select
ElseIf (col = 9) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP481200DD" & "  25013/" &
; Format(CStr(wk), "000")
         End If
            Cells(row, col + 1).Select
        
ElseIf (col = 10) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP443800EE" & "  25013/" &
; Format(CStr(wk), "000")
         End If
            Cells(row, col + 1).Select
ElseIf (col = 11) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP443901FG" & "  25013/" &
; Format(CStr(wk), "000")
         End If
            Cells(row, col + 1).Select
ElseIf (col = 12) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP444000FF" & "  25013/" &
; Format(CStr(wk), "000")
         End If
            Cells(row, col + 1).Select
    With ActiveCell.Characters(Start:=12, Length:=9).Font
        .Name = "Tahoma"
    End With
ElseIf (col = 13) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP444100CE" & "  25013/" &
; Format(CStr(wk), "000")
         End If
            Cells(row, col + 1).Select
          With ActiveCell.Characters(Start:=1, Length:=10).Font
        .Name = "Tahoma"
        End With
ElseIf (col = 14) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP444300BL" & "  25013/" &
; Format(CStr(wk), "000")
        End If
            Cells(row, col + 1).Select
ElseIf (col = 15) Then
        If (row > 2) Then
            wk = CLng(Right(Cells(row - 1, col).Value, 3)) + 1
             Cells(row, col).Value = "EP483700AA" & "  25013/" &
; Format(CStr(wk), "000")
         End If
ElseIf (col = 15) Then
        If (row > 2) Then
            wk = CLng(Left(Cells(row - 1, col).Value, 9)) + 1
             Cells(row, col).Value = Format(CStr(wk), "000000000") & "AF
B"
        End If
           Cells(row + 1, 1).Select
     ElseIf (col = 15) Then
        Cells(row, row).Select
    End If
End Sub

初心者なので応用がききません。

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

- Web Forum -