Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1628 / 13644 ツリー ←次へ | 前へ→

【72981】同じコードを検索して、同じコードがあれば1行前に行を移動するマクロ CAFE777 12/10/19(金) 9:22 質問[未読]
【72982】Re:同じコードを検索して、同じコードがあ... ウッシ 12/10/19(金) 10:19 発言[未読]
【72983】Re:同じコードを検索して、同じコードがあ... CAFE777 12/10/19(金) 12:02 発言[未読]
【72984】Re:同じコードを検索して、同じコードがあ... can 12/10/19(金) 12:36 発言[未読]
【72985】Re:同じコードを検索して、同じコードがあ... CAFE777 12/10/19(金) 12:49 発言[未読]
【72986】Re:同じコードを検索して、同じコードがあ... CAFE777 12/10/19(金) 12:51 発言[未読]
【72988】Re:同じコードを検索して、同じコードがあ... ウッシ 12/10/19(金) 13:30 回答[未読]
【72989】Re:同じコードを検索して、同じコードがあ... CAFE777 12/10/19(金) 13:45 お礼[未読]
【73030】Re:同じコードを検索して、同じコードがあ... CAFE777 12/10/25(木) 13:36 質問[未読]
【73031】Re:同じコードを検索して、同じコードがあ... ウッシ 12/10/25(木) 22:00 回答[未読]
【73034】Re:同じコードを検索して、同じコードがあ... cafe777 12/10/26(金) 10:01 お礼[未読]

【72981】同じコードを検索して、同じコードがあれ...
質問  CAFE777  - 12/10/19(金) 9:22 -

引用なし
パスワード
   目的:同じコードを検索して、同じコードがあれば1行前に行を移動するマクロ

以下のようなデータがあるとします。
A列にはコードがあり、A11行目からデータが入っています。
データが入る列はA列〜Q列までです。
A列に同じコードがある場合は、同じコードの下のコードを1行前に
行ごと移動したいと考えています。
どのように作成すればよいでしょうか?


A列・・・・・Q列
111・・・・・・・
111・・・・・・・
222・・・・・・・
333・・・・・・・
333・・・・・・・
444・・・・・・・
444・・・・・・・
555・・・・・・・

【72982】Re:同じコードを検索して、同じコードが...
発言  ウッシ  - 12/10/19(金) 10:19 -

引用なし
パスワード
   こんにちは

意味が良く分かりません。
普通のソートとは違うのですか?


▼CAFE777 さん:
>目的:同じコードを検索して、同じコードがあれば1行前に行を移動するマクロ
>
>以下のようなデータがあるとします。
>A列にはコードがあり、A11行目からデータが入っています。
>データが入る列はA列〜Q列までです。
>A列に同じコードがある場合は、同じコードの下のコードを1行前に
>行ごと移動したいと考えています。
>どのように作成すればよいでしょうか?
>
>
>A列・・・・・Q列
>111・・・・・・・
>111・・・・・・・
>222・・・・・・・
>333・・・・・・・
>333・・・・・・・
>444・・・・・・・
>444・・・・・・・
>555・・・・・・・

【72983】Re:同じコードを検索して、同じコードが...
発言  CAFE777  - 12/10/19(金) 12:02 -

引用なし
パスワード
   ウッシさん
こんにちは^^

訂正
A列・・・・・・Q列
すいか
ばなな
ばなな
りんご
なし
すいか
なし
りんご

こんな感じのデータとします。
言われているのはソートですね。
ソートではまずいです。(入力した順番まで変わってしまうので)
例えばソート昇順にすると

すいか
すいか
なし
ばなな
ばなな
りんご
りんご


↑こうなりますね。


上から入力した順番はかえないで、2つの商品名を検索して同じ商品名が
あれば、1行前に移動。
条件は、同じ商品名は存在しない
だけど、単価が変わったりした場合、先に入力しているものをデリートすれば
いいんですが、前の情報も残しておきたいので。
▼ウッシ さん:
>こんにちは
>
>意味が良く分かりません。
>普通のソートとは違うのですか?
>
>
>▼CAFE777 さん:
>>目的:同じコードを検索して、同じコードがあれば1行前に行を移動するマクロ
>>
>>以下のようなデータがあるとします。
>>A列にはコードがあり、A11行目からデータが入っています。
>>データが入る列はA列〜Q列までです。
>>A列に同じコードがある場合は、同じコードの下のコードを1行前に
>>行ごと移動したいと考えています。
>>どのように作成すればよいでしょうか?
>>
>>
>>A列・・・・・Q列
>>111・・・・・・・
>>111・・・・・・・
>>222・・・・・・・
>>333・・・・・・・
>>333・・・・・・・
>>444・・・・・・・
>>444・・・・・・・
>>555・・・・・・・

【72984】Re:同じコードを検索して、同じコードが...
発言  can  - 12/10/19(金) 12:36 -

引用なし
パスワード
   元データが
A列・・・・・・Q列
すいか
ばなな
ばなな
りんご
なし
すいか
なし
りんご
だとすると、希望する結果はどうなるのですか。

【72985】Re:同じコードを検索して、同じコードが...
発言  CAFE777  - 12/10/19(金) 12:49 -

引用なし
パスワード
   canさん 
こんにちは ^^

元データ
(わかりやすくするために最初に入力したものを○○○1とし、
後で入力したものを2とします。ですが、実際のデータには○○○の表示になります)

A列・・・・・・Q列
すいか1
ばなな1
ばなな2
りんご1
なし1
すいか2
なし2
りんご2

下記のようにしたいと思っています。
すいか2
すいか1
ばなな2
ばなな1
りんご2
りんご1
なし2
なし1

【72986】Re:同じコードを検索して、同じコードが...
発言  CAFE777  - 12/10/19(金) 12:51 -

引用なし
パスワード
   追記

最初に入力したもの ex)りんご1
後で入力したもの  ex)りんご2

というのは、1つの商品に対しての 最初=1 後=2
です。

【72988】Re:同じコードを検索して、同じコードが...
回答  ウッシ  - 12/10/19(金) 13:30 -

引用なし
パスワード
   こんにちは

作業列に、同じコード毎に入力順を振る数式をセットしてソートします。

同じコードは最大2つまでとしています。
作業列はR列としてます。
データは11行目からで、項目名は無しとしています。

Sub test1()
  Dim i As Long
  Dim r As Range
  Const j As Long = 17
  i = Cells(Rows.Count, 1).End(xlUp).Row
  Set r = Range("A11", Cells(i, j))
  With r.Offset(, j).Columns(1)
    Application.Calculation = xlCalculationManual
    .Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=2," & _
      "MAX(OFFSET(A10:A$11,0," & j & "))+2," & _
        "OFFSET(A$11,MATCH(A11,A10:A$11,0)-1," & j & ")-1)"
    .Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
    Application.Calculation = xlCalculationAutomatic
    .Value = .Value
    r.Resize(, r.Columns.Count + 1).Sort _
      key1:=r(1, 1).Offset(, j), Order1:=xlAscending
    .ClearContents
  End With
End Sub

【72989】Re:同じコードを検索して、同じコードが...
お礼  CAFE777  - 12/10/19(金) 13:45 -

引用なし
パスワード
   ウッシさん
こんにちは^^

おもっきり感動です。
ありがとうございます。
自分ではこんなコード思いつきません。
感謝感謝です。^^

【73030】Re:同じコードを検索して、同じコードが...
質問  CAFE777  - 12/10/25(木) 13:36 -

引用なし
パスワード
   こんにちは^^
以前に質問をし、ウッシさんから回答をいただき解決しました。
その際に「同じコードは最大2つまで」の条件がありました。
この条件では全く問題なくご提示いただきましたコードでばっちりでした。
が、たとえば、イレギュラーで同じコード(A列)が、3つや4つになった場合にも
下記の例でいえば、りんご3がりんごの中で1番上にいくようなことはできますか?
色々コードを修正したりしたんですが、八方ふさがりです。
どうかご教授願います。


例)
A列・・・・・Q列
りんご1
ばなな1
なし1
なし2 
ばなな2
りんご2
りんご3

※希望結果
例)
A列・・・・・Q列
りんご3
りんご2
りんご1
ばなな2
ばなな1
なし2
なし1


Sub test1()
  Dim i As Long
  Dim r As Range
  Const j As Long = 17
  i = Cells(Rows.Count, 1).End(xlUp).Row
  Set r = Range("A11", Cells(i, j))
  With r.Offset(, j).Columns(1)
    Application.Calculation = xlCalculationManual
    .Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=2," & _
      "MAX(OFFSET(A10:A$11,0," & j & "))+2," & _
        "OFFSET(A$11,MATCH(A11,A10:A$11,0)-1," & j & ")-1)"
    .Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
    Application.Calculation = xlCalculationAutomatic
    .Value = .Value
    r.Resize(, r.Columns.Count + 1).Sort _
      key1:=r(1, 1).Offset(, j), Order1:=xlAscending
    .ClearContents
  End With
End Sub

【73031】Re:同じコードを検索して、同じコードが...
回答  ウッシ  - 12/10/25(木) 22:00 -

引用なし
パスワード
   こんばんは

最初から計算式を複数データに対応しておけば良かったですね。

Sub test2()
  Dim i As Long
  Dim r As Range
  Const j As Long = 17
  i = Cells(Rows.Count, 1).End(xlUp).Row
  Set r = Range("A11", Cells(i, j))
  With r.Offset(, j).Columns(1)
    .Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=COUNTIF(A$11:A$" & i & ",A11)," & _
      "MAX(OFFSET(A10:A$11,0," & j & "))+COUNTIF(A$11:A$" & i & ",A11)," & _
        "OFFSET(A$11,MATCH(A11,A11:A$11,0)-1," & j & ")-COUNTIF(A$11:A10,A11))"
    .Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
    .Value = .Value
    r.Resize(, r.Columns.Count + 1).Sort _
      key1:=r(1, 1).Offset(, j), Order1:=xlAscending
    .ClearContents
  End With
End Sub

こんな感じで。

▼CAFE777 さん:
>こんにちは^^
>以前に質問をし、ウッシさんから回答をいただき解決しました。
>その際に「同じコードは最大2つまで」の条件がありました。
>この条件では全く問題なくご提示いただきましたコードでばっちりでした。
>が、たとえば、イレギュラーで同じコード(A列)が、3つや4つになった場合にも
>下記の例でいえば、りんご3がりんごの中で1番上にいくようなことはできますか?
>色々コードを修正したりしたんですが、八方ふさがりです。
>どうかご教授願います。
>
>
>例)
>A列・・・・・Q列
>りんご1
>ばなな1
>なし1
>なし2 
>ばなな2
>りんご2
>りんご3
>
>※希望結果
>例)
>A列・・・・・Q列
>りんご3
>りんご2
>りんご1
>ばなな2
>ばなな1
>なし2
>なし1
>
>
>Sub test1()
>  Dim i As Long
>  Dim r As Range
>  Const j As Long = 17
>  i = Cells(Rows.Count, 1).End(xlUp).Row
>  Set r = Range("A11", Cells(i, j))
>  With r.Offset(, j).Columns(1)
>    Application.Calculation = xlCalculationManual
>    .Formula = "=IF(COUNTIF(A11:A$" & i & ",A11)=2," & _
>      "MAX(OFFSET(A10:A$11,0," & j & "))+2," & _
>        "OFFSET(A$11,MATCH(A11,A10:A$11,0)-1," & j & ")-1)"
>    .Cells(1, 1).Formula = "=COUNTIF(A11:A$" & i & ",A11)"
>    Application.Calculation = xlCalculationAutomatic
>    .Value = .Value
>    r.Resize(, r.Columns.Count + 1).Sort _
>      key1:=r(1, 1).Offset(, j), Order1:=xlAscending
>    .ClearContents
>  End With
>End Sub

【73034】Re:同じコードを検索して、同じコードが...
お礼  cafe777  - 12/10/26(金) 10:01 -

引用なし
パスワード
   ウッシさん
おはようございます。
遅番にありがとうございます。
希望通りの結果がでました。
重ね重ねありがとうございます。

1628 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free