[[20160616095154]] 『マクロについて』(kysj) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロについて』(kysj)

200行くらいあるセルに1要一、3英夫、4慎太郎2俊、空欄など
半角数字(0〜6)と名前(複数もあり)が入っています。
0○○は0のまま、1〜5○○はプラス1、6○○は削除するマクロ
はできるでしょうか?
よろしくお願いします。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


できます!

頑張ってください。
(?) 2016/06/16(木) 10:31


 Sub test()
    Dim i As Long
    Dim j As Long
    Dim cw As String
    Dim vw As Variant

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        cw = Cells(i, "A").Value
        For j = Len(cw) To 2 Step -1
            If Mid(cw, j, 1) Like "[0-9]" Then
                cw = Left(cw, j - 1) & "、" & Mid(cw, j)
            End If
        Next j

        vw = Split(cw, "、")
        For j = 0 To UBound(vw)
            Select Case Left(vw(j), 1)
            Case 6
                vw(j) = ""
            Case 1 To 5
                vw(j) = Left(vw(j), 1) + 1 & Mid(vw(j), 2)
            Case 0
            End Select
        Next j
        Cells(i, "A").Value = Join(vw, "")
    Next i
 End Sub
(???) 2016/06/16(木) 11:03

Sub main() '対象がA列の場合
    Dim i As Integer
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If IsNumeric(Left(Range("A" & i).Value, 1)) Then
            If Left(Range("A" & i), 1) > 0 And Left(Range("A" & i), 1) < 7 Then Range("A" & i) = Left(Range("A" & i), 1) * 1 + 1 & Mid(Range("A" & i), 2)
            If Left(Range("A" & i).Value, 1) = 7 Then Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub
(mm) 2016/06/16(木) 11:10

mmさん、多分「4慎太郎2俊」がミソですよ。名前複数あり、との事ですし、打ち間違いではないのだと思います。
(???) 2016/06/16(木) 11:26

 ???さんとかぶりますが メモしましたので。

 失礼します。

 >0○○は0のまま、1〜5○○はプラス1、6○○は削除する

 削除の意味ですけど、たとえば 0○○4■■6□□3▲▲ という文字列だった場合、

 0○○5■■4▲▲ にするということではないですか?

(β) 2016/06/16(木) 11:30


そのとおりでして、6○○だけ削除してあとは残し、空欄になったとしても行は削除したくないのです。
よろしくお願いします。
(kysj) 2016/06/16(木) 12:24

よろしく、じゃなくて、私のコードは最初からそのつもりで書いてますよ?
結構面倒なロジックになるので、言葉で言っても判ってもらえないだろうから、コーディング例を書きました。
(???) 2016/06/16(木) 12:54

 私も書いてみました。
 上級者さんだったら1回の正規表現処理で、かつ変換も正規表現で可能なんでしょうが、とりあえず。

 Sub Sample()
    Dim reg As Object
    Dim c As Range
    Dim mt As Object
    Dim sm As Object
    Dim x As Long
    Dim v As Variant

    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
    v = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
    For x = 1 To UBound(v, 1)
        reg.Pattern = "6[^0-9]+"
        v(x, 1) = reg.Replace(v(x, 1), "") '6xxxx の削除
        reg.Pattern = "[1-5]{1}(?=[^0-9]+)"
        For Each sm In reg.Execute(v(x, 1))
            Mid(v(x, 1), sm.firstindex + 1) = Val(sm.Value) + 1
        Next
    Next
    Range("A1").Resize(UBound(v, 1)).Value = v

 End Sub

(β) 2016/06/16(木) 13:02


できました。大変ありがとうございました。
(kysj) 2016/06/16(木) 13:26

よかったですね

頑張らなくても出来るんです。
(?) 2016/06/16(木) 13:32


追加でお願いします。
違う列に数字(101〜7百番台)があります。
101から5百番台はプラス100、601〜6百番台は数字を削除、701〜はそのまま
以上を同時にできますか?
よろしくお願いします。

(kysj) 2016/06/16(木) 16:12


追加分は、これまでのコーディング例を参考に、まずはご自分で試行錯誤してみてください。
(???) 2016/06/16(木) 16:27

 A列とは連携せず、単純に、その別の列の単独処理ですね?
 それと、その列には【数値】だけがあるのですか?
 あるいは、A列のように、文字列があって、その中に 数字もあるパターンですか?

(β) 2016/06/16(木) 16:29


数字のみで、A列と連携して処理したいのです。
よろしくお願いします。
(kysj) 2016/06/16(木) 16:37

 A列と連携という意味がよくわかりません。
 新しい処理だけのコードです。
 もし同時に処理したいという意味であれば

 Sub 同時に処理()
   すでにアップされている ???さんのプロシジャ あるいは βのプロシジャ
   新しいプロシジャ
 End Sub

 こんなコードを書いて、これを実行されてはいかがですか。

 なお、本件、シート上の数式処理で、さらに別の列に結果を出すこともできると思いますが
 VBA処理がご希望なら。(700 をどう扱うのか不明ですが 700以上はそのままにしました)

 列記号は適宜変更してください。

 Sub 新しいプロシジャ()
    Const COL As String = "G"

    With Range(COL & 1, Range(COL & Rows.Count).End(xlUp))
        .Value = Evaluate("IF(" & .Address & "<600," & .Address & "+100,IF(" & .Address & "<700,""""," & .Address & "))")
    End With

 End Sub

(β) 2016/06/16(木) 18:44


皆さん ありがとうございました。
(kysj) 2016/06/17(金) 08:43

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.