Results of 1 - 1 of about 37655 for IF (0.008 sec.)
- [[20230901145126]]
- #score: 1592
- @digest: 0c72f12542679817466c91c273f7258b
- @id: 94991
- @mdate: 2023-09-14T22:54:12Z
- @size: 19744
- @type: text/plain
- #keywords: 替元 (53066), srcrng (48620), ガネ (47678), 替先 (43139), メガ (29397), 入替 (23521), 列). (19717), dstrng (16748), 列), (15093), ネ） (11649), 行範 (7525), 列範 (7148), 動先 (5721), 行, (5352), 番目 (4855), ル】 (4723), 列= (4664), myrng (4551), 2023 (4523), columns (4058), xltoleft (4040), nothing (3387), （メ (3377), 列) (3145), parent (2902), 白茶 (2565), 囲内 (2335), worksheetfunction (2288), イミ (2128), 例示 (2116), 「a (2116), cells (2098)
- 『マクロでセルの値変換』（メガネ）
下記のような表で同一列にAが3個ある場合、上から2番目のAをCに変換したい できればマクロでの方法を教えてください。 A_ B_ C_ 1_ あ い う 2_ C C C 3_ C A C 4_ A A C 5_ C C C 6_ A A C 7_ C C C 8_ A C C 9_ C C A 10_ C C C 11_ C C A 12_ C C A ＜ 使用 Excel:Excel2021、使用 OS:Windows10 ＞ ---- 同一シートに上記以外の表がないことが前提で Sub Sample() ' Dim rng As Range Dim r As Long Dim er As Long Dim c As Long Dim ec As Long Dim v As Variant Dim f As Boolean ' Set rng = Worksheets(該当シート名かインデックス).UsedRange v = rng.Value ' er = rng.Rows.Count ec = rng.Columns.Count For c = 1 To ec f = False For r = 1 To er If v(r, c) = "A" Then Select Case f Case True: v(r, c) = "C": Exit For Case False: f = True End Select End If Next r Next c rng.Value = v End Sub シート名はダブルコーテーションで括ってくださいな （ 'ふ'） 2023/09/01(金) 16:13:57 ---- 'ふ'さん ありがとうございます。上から2番目のAがCに変更できました。 このコードに「列にAが3個の場合実行する」を追加したいのですがどのように記述したらよいか教えてください。 （メガネ） 2023/09/02(土) 12:56:43 ---- ざっくり↓こんな風に考えれば宜しいかと。 (やってる事は結局'ふ'さんの例と同じ事です) Dim c As Range, r As Range, a As Range, i As Long For Each c In [A2:C12].Columns For Each r In c.Rows If r.Value = "A" Then i = i + 1 If i = 3 Then Exit For If a Is Nothing Then If i = 2 Then Set a = r Next If i = 3 Then a.Value = "[C]" Set a = Nothing i = 0 Next （白茶） 2023/09/02(土) 13:34:35 ---- こんな感じにも書けますね。 Sub test() Dim rng As Range Dim r As Range Dim cnt As Long For Each rng In Range("A1").CurrentRegion.Columns If Application.CountIf(rng, "A") = 3 Then cnt = 0 For Each r In rng.Cells If r = "A" Then cnt = cnt + 1 If cnt = 2 Then r = "C" Exit For End If End If Next End If Next End Sub （xyz） 2023/09/02(土) 14:48:56 ---- Sub test() Dim c As Range Dim a As String, f As String For Each c In Cells(1).CurrentRegion.Columns If WorksheetFunction.CountIf(c, "A") = 3 Then a = c.Address f = "IF(" _ & "ROW(" & a & ")=SMALL(IF(" & a & "=""A"",ROW(" & a & "),10^7),2)," _ & """C""," _ & a & ")" c.Value = c.Parent.Evaluate(f) End If Next End Sub （マナ） 2023/09/02(土) 21:17:50 ---- 白茶さん xyzさん マナさん 同じ「列」の2番目のAを無事Cに変更することができました。3つの事例ともに勉強になりました。ありがとうございます。 引き続きの質問ですが、同じ「列」の2番目のAを同じ「行」の他の列のCと入れ替えるにはどのようしたらよいですか。 例）セルA4の「A」とセルC4の「C」を入れ替える 白茶さんのコードで Dim c As Range, r As Range, a As Range, i As Long For Each c In [A2:C12].Columns For Each r In c.Rows If r.Value = "A" Then i = i + 1 If i = 3 Then Exit For If a Is Nothing Then If i = 2 Then Set a = r Next If i = 3 Then a.Value = まではイメージできたのですがその後、どのようにしたら良いか教えてください。 （メガネ） 2023/09/06(水) 00:48:37 ---- >同じ「行」の他の列 例えば... ○aのふたつ右隣 a.Offset(,2) ○C列のaと同じ行 a.EntireRow.Columns(3) ○aの属する行とC列が交差するセル Intersect(a.EntireRow, Columns(3)) みたいに表現方法は色々あります。 そこが「C」だったら「入れ替える」という書き方になろうかと思います。 （白茶） 2023/09/06(水) 08:57:17 ---- 編集がかぶりしましたがそのまま。 横からですが、【他の列】とは具体的にどの列を指しますか? 最初の例示に従えば、【B列】も「同一列にAが3個」という条件を満たしていますが、【A列】と【C列】の組み合わせになる理由はありますか? また、【A列】の2番目のAは、A6セルかとおもいますが、例示ミスですか? （もこな2 ） 2023/09/06(水) 09:01:30 ---- 白茶さん ありがとうございます。試してみます。 （メガネ） 2023/09/06(水) 09:20:36 ---- もこな2さん 質問ありがとうございます。補足させていただきます。 他の列は、2番目のAがある列以外で同じ行にCがある列になります。 [A列]と[C列]の組み合わせになる理由はありません。 例示訂正 [A列]の2番目のAはA6セルになります。 例示ミスでした。失礼しました。 （メガネ） 2023/09/06(水) 09:36:12 ---- そうなると↓みたいな感じでよいように思います 【処理条件】 ・入替元セル:「 同じ列に"A"が3つある」and「上から2番目の"A"」 ・入替先セル:「↑の【列より後ろ】」and「値が"C"」 【処理の流れ】 1. 1列目から最後の列まで順番に見ていき 2. もしも「列にAが3つあるならば」 3. 「上から2番目の"A"」の【セル】を覚える 4. ループを抜ける 5. もしもの話はおしまい 6. 全部見終わったら終了 7. もしも覚えた【セル】があったら 8. 覚えた【セル】の列+1から最後の列まで順番にみていき 9. もしも「その列の覚えた【セル】の行」の値が"C"なら 10. 「その列の覚えた【セル】の行」の値を"A"に書き換える 11. 「覚えた【セル】」の値を"C"に書き換える 12. ループを抜ける 13. もしもの話はおしまい 14. 全部見終わったら終了 15. もしもの話はおしまい ↑なら以下のようになるので目的が達成できると思います。 【入替元セル】が見つからないとき・・・・7以降が実行されない 【入替先セル】が見つからないとき・・・・10〜12が実行されない （もこな2 ） 2023/09/06(水) 12:07:07 ---- もこな2さん ありがとうございます。 「上から2番目の"A"」の【セル】を覚える をコードで書くとどのような表記名なるか教えてください。 （メガネ） 2023/09/06(水) 16:27:58 ---- 確認です。 以下のケースでは結果はどうなるんですか? 結果を示してください。 各列で「Aが3個」というのはどのタイミングで判断しますか? 前の列からAが移動してくることもあるわけで、 ・動的に判断するんですか、 ・それとも当初の状態で「Aが3個」を判断するんですか? 上から2番目という判断も同じです。動的にするんですかね。 A B C 1 あ い う 2 C C C 3 C A C 4 A C C 5 C C C 6 A C C 7 C A C 8 A C C 9 C C A 10 C C C 11 C C A 12 C C C （xyz） 2023/09/06(水) 18:11:02 ---- xyzさん ご確認ありがとうございます。ご指摘のもと補足させていただきます。 当初の状態で「Aが3個」を判断します。 しかしご指摘のとおり、移動先の列のAが3個になってしまうことがあります。 移動先の条件を追加で、「Aの移動先の列はAが1個以下」にしないといけないことに気が付きました。 条件が定まっていなく失礼しました。よろしくお願いします。 （メガネ） 2023/09/06(水) 19:42:15 ---- ■1 ＞【セル】を覚えるをコードで書くと〜 やり方はいろいろあると思いますが、オブジェクト型の変数に格納するのがやりやすいと思います。 Sub 研究用() Stop Dim MyRNG As Range If Not MyRNG Is Nothing Then MsgBox "覚えたセルは" & vbLf & _ " ブック:" & MyRNG.Parent.Parent.Name & vbLf & _ " シート:" & MyRNG.Parent.Name & vbLf & _ " セル番地:" & MyRNG.Address(False, False) & vbLf & _ "です" End If Set MyRNG = ThisWorkbook.Worksheets(1).Range("A1") If Not MyRNG Is Nothing Then MsgBox "覚えたセルは" & vbLf & _ " ブック:" & MyRNG.Parent.Parent.Name & vbLf & _ " シート:" & MyRNG.Parent.Name & vbLf & _ " セル番地:" & MyRNG.Address(False, False) & vbLf & _ "です" End If End Sub ■2 上記を踏まえて「2023/09/06(水) 12:07:07」の内容をコード化するとこんな感じです。 Sub 研究用() Stop 'ブレークポイントの代わり Dim 行 As Long, 列 As Long Dim c As Long Dim MyRNG As Range With ActiveSheet For 列 = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If WorksheetFunction.CountIf(.Columns(列), "A") = 3 Then For 行 = 2 To .Cells(.Rows.Count, 列).End(xlUp).Row If .Cells(行, 列).Value = "A" Then c = c + 1 If c = 2 Then Set MyRNG = .Cells(行, 列) Exit For End If End If Next 行 End If If Not MyRNG Is Nothing Then Exit For Next 列 For 列 = MyRNG.Column + 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If .Cells(MyRNG.Row, 列).Value = "C" Then .Cells(MyRNG.Row, 列).Value = "A" MyRNG.Value = "C" Exit For End If Next 列 End With End Sub ※1 研究用として提供していますので、丸パクリして完成!というのはご遠慮ください。 （興味があれば【ステップ実行】等により研究の上、必要な部分のみご自身のコードに組み込んでください） ※2 一回のみの処理であれば、上記のように【入替元セル】【入替先セル】それぞれを特定してから処理すればよいように思います。 （そうじゃなくて、処理（入れ替え）後にも処理するならば、既に指摘があるように"どのタイミングで"判定するのか説明してください。） （もこな2） 2023/09/06(水) 21:00:23 ---- もこな2さん コードのご提供ありがとうございます。 2023/09/06(水) 12:07:07の解説と照らし合わせ消化しています。 ステップ実行で追ってみたのですが入替えが実行されませんでした。 特にエラーにもならず終了していることから何か条件が違っているのでしょうか? （メガネ） 2023/09/07(木) 09:49:59 ---- ↓を実行して、イミディエイトに何と出力されたか教えてください。 Sub 検証用() Dim 行 As Long, 列 As Long Dim c As Long Dim srcRNG As Range, dstRNG As Range With ActiveSheet For 列 = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If WorksheetFunction.CountIf(.Columns(列), "A") = 3 Then For 行 = 2 To .Cells(.Rows.Count, 列).End(xlUp).Row If .Cells(行, 列).Value = "A" Then c = c + 1 If c = 2 Then Set srcRNG = .Cells(行, 列) Exit For End If End If Next 行 End If If Not srcRNG Is Nothing Then Exit For Next 列 If srcRNG Is Nothing Then Debug.Print " 入替元が見つかりませんでした" Else For 列 = srcRNG.Column + 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If .Cells(srcRNG.Row, 列).Value = "C" Then Set dstRNG = .Cells(srcRNG.Row, 列) Exit For End If Next 列 End If End With If dstRNG Is Nothing Then Debug.Print " 入替元:" & srcRNG.Address & vbTab & "入替先はみつかりませんでした" Else Debug.Print " 入替元:" & srcRNG.Address & vbTab & "入替先:" & dstRNG.Address End If End Sub （もこな2 ） 2023/09/07(木) 12:38:30 ---- 同一シートに他の表がないことが前提で Function 列範囲内で任意の位置のAが入力されているセルを返しなさい(ByVal 範囲 As Range, _ Optional ByVal n番目 As Long = 1, _ Optional ByVal 探し方 As Boolean = True) As Range '指定した数のAがなかったら終了 Dim cnt As Long cnt = WorksheetFunction.CountIf(範囲, "A") If cnt < 3 Or cnt < n番目 Then Exit Function '昇順/降順でn番目にあるAが入力されているセルを返す Dim v As Variant Dim r As Long Dim sr As Long Dim er As Long Dim St As Long v = 範囲.Value Select Case 探し方 Case True: sr = 1: er = UBound(v, 1): St = 1 '昇順 Case False: sr = UBound(v, 1): er = 1: St = -1 '降順 End Select cnt = 0 For r = sr To er Step St If v(r, 1) = "A" Then cnt = cnt + 1 'Aの数を数える If cnt = n番目 Then Exit For 'n番目になったら終了 Next r 'n番目のAが入力されているセルを返す Set 列範囲内で任意の位置のAが入力されているセルを返しなさい = 範囲.Cells(r, 1) End Function Function 任意の行範囲内で直近のCが入力されているセルを返しなさい(ByVal 範囲 As Range) As Range '指定した行にCがなかったら終了 Dim c As Long c = Application.Match("C", 範囲, 0) If IsError(c) Then Exit Function '直近のCが入力されているセルを返す Set 任意の行範囲内で直近のCが入力されているセルを返しなさい = 範囲.Cells(1, c) End Function Sub Sample() ' Dim rng As Range Dim er As Long Dim ec As Long Set rng = Worksheets(該当シート名またはIndex).UsedRange '全体の範囲 er = rng.Rows.Count '行の長さ ec = rng.Columns.Count '列の長さ ' Dim 列範囲 As Range Dim 行範囲 As Range Dim A対象 As Range Dim C対象 As Range Dim c As Long Dim v As Variant For c = 0 To ec - 1 Set 列範囲 = rng.Resize(1, er).Offset(0, c) Set A対象 = 列範囲内で任意の位置のAが入力されているセルを返しなさい(列範囲, 2) If Not A対象 Is Nothing Then 'A対象のセルが返ってきていれば処理 Set 行範囲 = rng.Cells(c + 1, 1).Resize(1, ec - c) Set C対象 = 任意の行範囲内で直近のCが入力されているセルを返しなさい(行範囲) If Not C対象 Is Nothing Then 'C対象のセルが返って生きていれば処理 v = A対象.Value A対象.Value = C対象.Value C対象.Value = v End If End If Next c End Sub こんな感じとかどうですか? （ 'ふ'） 2023/09/07(木) 16:31:21 ---- もこな2さん イミディエイトに 「入替元:$A$5 入替先:$C$5」と表示されました。 しかし$C$5は、「C」のままで、「A」とは入れ替わりませんでした。 （メガネ） 2023/09/08(金) 10:35:13 ---- ＞イミディエイトに 「入替元:$A$5 入替先:$C$5」と表示されました。 うーん。謎ですね。 とりあえず、両方のセルは見つかっているようなので↓でどうでしょうか? Sub 別案() Dim 行 As Long, 列 As Long, c As Long Dim srcRNG As Range, dstRNG As Range Dim buf As Variant With ActiveSheet For 列 = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If WorksheetFunction.CountIf(.Columns(列), "A") = 3 Then For 行 = 2 To .Cells(.Rows.Count, 列).End(xlUp).Row If .Cells(行, 列).Value = "A" Then c = c + 1 If c = 2 Then Set srcRNG = .Cells(行, 列) Exit For End If End If Next 行 End If If Not srcRNG Is Nothing Then Exit For Next 列 If Not srcRNG Is Nothing Then For 列 = srcRNG.Column + 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If .Cells(srcRNG.Row, 列).Value = "C" Then Set dstRNG = .Cells(srcRNG.Row, 列) Exit For End If Next 列 End If End With If Not dstRNG Is Nothing Then buf = srcRNG.Value srcRNG.Value = dstRNG.Value dstRNG.Value = buf End If End Sub （もこな2 ） 2023/09/08(金) 12:14:26 ---- もこな2さん ありがとうございます。 buf = srcRNG.Value srcRNG.Value = dstRNG.Value dstRNG.Value = buf これでいれかえてることを理解しました。 （メガネ） 2023/09/08(金) 15:29:55 ---- もこな2さん 2023/09/08(金) 12:14:26にご提示いただいたコードで、 「A」移動先の「C」の列に「A」が無いという条件を追加したいのですが If Not srcRNG Is Nothing Then ここをどのように変えたらよいか教えてください。 （メガネ） 2023/09/08(金) 17:43:51 ---- 提示されたコードで同じように3個あるか判定してますよね。 少しは自分で考えたらどうですか? （苦言） 2023/09/08(金) 17:46:26 ---- 苦言さん おっしゃるとおり 3個あるか判定している If WorksheetFunction.CountIf(.Columns(列), "A") = 3 Then を If Not srcRNG Is Nothing Then と入れ替えてみたのですが入替ができませんでした? 他にどこを変えたらよいか教えてください。 （メガネ） 2023/09/08(金) 18:14:48 ---- If Not srcRNG Is Nothing Then と入れ替えたのは If WorksheetFunction.CountIf(.Columns(列), "A") = 0 Then でした。 失礼しました。 （メガネ） 2023/09/08(金) 18:17:03 ---- ちょっとよくわからないので、【全体を提示】したうえで、【ステップ実行】したときに、どの箇所が実行されずに困っているか教えてください。 （もこな2 ） 2023/09/13(水) 08:43:56 ---- 書き忘れ 【入れ替え】と表現されていますが、↓は何しているか理解出来てますか? If Not srcRNG Is Nothing Then それを取っ払ったらsrcRNGが見つかって無くとも処理が進んでしまうので、ちょっとマズくないですか? 箇所の【入れ替え】ならその限りでは無いですが、最終的な処理ができませんからdstRNGを探すだけ無駄になるので、もとの場所の方がよいとおもいます。 （もこな2 ） 2023/09/13(水) 08:58:17 ---- ＞「A」移動先の「C」の列に「A」が無いという条件を追加したい 残念ながら反応が無いですが、条件を追加ですから【入れ替える】のではなく【追加】しないとダメですよ。 Sub 別案_改() Dim 行 As Long, 列 As Long, c As Long Dim srcRNG As Range, dstRNG As Range Dim buf As Variant With ActiveSheet For 列 = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column If WorksheetFunction.CountIf(.Columns(列), "A") = 3 Then For 行 = 2 To .Cells(.Rows.Count, 列).End(xlUp).Row If .Cells(行, 列).Value = "A" Then c = c + 1 If c = 2 Then Set srcRNG = .Cells(行, 列) Exit For End If End If Next 行 End If If Not srcRNG Is Nothing Then Exit For Next 列 If Not srcRNG Is Nothing Then For 列 = srcRNG.Column + 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column 【追加】もしも、列の"A"の個数が0より多ければ If .Cells(srcRNG.Row, 列).Value = "C" Then Set dstRNG = .Cells(srcRNG.Row, 列) Exit For End If 【追加】もしもの話はおしまい Next 列 Else MsgBox "元が見つかりません" End If End With If Not dstRNG Is Nothing Then MsgBox "元・先どちらもみつかりました" Else MsgBox "元は見つかりましたが、先がみつかりません" End If End Sub （もこな2） 2023/09/15(金) 07:54:12... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202309/20230901145126.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97039 documents and 608037 words.
訪問者：