VB2.0～VB6.0用掲示板のログNo.1（2002/08/13～2004/08/10）

[リストへもどる]

一括表示

まとめ方 - MAI 09/04-10:26 No.5718
- Re: まとめ方（削除しました） - テスト 09/04-13:39 No.5721
  - Re^2: まとめ方 - MAI 09/04-13:57 No.5722
- Re: まとめ方 - よねＫＥＮ 09/04-14:07 No.5723
  - Re^2: まとめ方(1例) - よねＫＥＮ 09/04-14:46 No.5726
    - Re^3: まとめ方(1例) - MAI 09/04-15:10 No.5728
- 回答ではありません。 - 魔界の仮面弁士 09/04-17:41 No.5733

投稿時間：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

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

投稿時間：2003/09/04(Thu) 13:39 投稿者名：テストＥメール：ＵＲＬ　：タイトル：Re: まとめ方（削除しました）

申し訳ありませんが削除させて頂きました。

投稿時間：2003/09/04(Thu) 13:57 投稿者名：MAI ＵＲＬ　：タイトル：Re^2: まとめ方

ありがとうございます。テストさん。助かります。
行き詰まっていました。
でも、このやり方では一回一回実行しなくてはいけません。
さらにMID関数使いたいというわがままが出てきました。
今、必死で試行錯誤しています。

投稿時間：2003/09/04(Thu) 14:07 投稿者名：よねＫＥＮＥメール：ＵＲＬ　：タイトル：Re: まとめ方

> こんな長いのをモジュールで書いてみました。
> 簡単にする方法はないでしょうか？

その前にこの関数でどういうことをしようとしているのでしょうか？
関数のしようとしていること(仕様)は書いて下さいね。
処理を内容を維持しつつ簡潔に書きなおすには、表面上のコードの類似性を見るだけでなく、
そのコードの意味を理解することが重要になってきます。

それからコードを見るとExcel VBAのようですが、Excel VBAですか？バージョンは何ですか？
＃今回はこの辺りの情報はあまり重要ではないかもしれませんが、
＃技術系の質問ではこういう情報も明記しましょう。

例えば、コードの下記の部分では、

> If (col = 1) Then
>      If (row > 2) Then
>             Cells(row, col).Value = Cells(row - 1, col).Value
>             Cells(row, col).Value = "MW-25014"

3行目のコードは意味がありません。
要はcol=1、row>2のときは固定値"MW-25014"を代入するということでいいのでしょうか？
それとも「Cells(row, col).Value = Cells(row - 1, col).Value」の行は
何らかの記述ミスでしょうか？

他にも関数の仕様抜きで考えても論理的におかしいのでは？と思われる部分がいくつかあります。
このコードは実際のコードのコピペですか？
実際のコードでないなら、実際の動くコードを載せて下さい。

投稿時間：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

投稿時間：2003/09/04(Thu) 15:10 投稿者名：MAI ＵＲＬ　：タイトル：Re^3: まとめ方(1例)

よねKENさんありがとうございます。
A1からO１（横１列）に日付やら出荷日、仕様、型番などを明記しています。
A2からO2にはそれらに対する日時や番号などを明記しています。
Enterを押すことでカーソルが横に、ドンドン上の値の＋１や日付を出します。

問題①：ここで日付が変わったり、EP4812DDがEP4812DEになった時に上の値を参照してくれません（”E
P4812DD”としているから）。
問題②文章も長いのでMid関数などを使って文章をまとめたい。

今はこんなことに挑戦しています。

投稿時間：2003/09/04(Thu) 17:41 投稿者名：魔界の仮面弁士Ｅメール：ＵＲＬ　：タイトル：回答ではありません。

すみません。下記とあわせて読んでいるのですが、
質問の内容が理解できませんでした。。。

http://hpcgi1.nifty.com/MADIA/VBBBS2/wwwlng.cgi?print+200309/03090021.txt

『Mid関数などを使って文章をまとめたい』との事ですが、
データの規則性（仕様）がわからないので、まとめにくいです。

そもそも、"EP444100CE 25013/001" などのデータは、20桁固定なのでしょうか？