Excel VBA質問箱 IV

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

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


54297 / 76732 ←次へ | 前へ→

【27231】Re:値の振り分けです。どうかよろしくお願い...
発言  ponpon  - 05/8/3(水) 0:13 -

引用なし
パスワード
   ▼℃素人 さん:
こんばんは。

意味がよく分からないのですが、こんな感じでしょうか?

 前提 A〜C列までのデータとする。
    same differentは、入力済みとする。
    並べ替えは、行われていないとする。 
    データ数は、A列で見ています。    以上

 test1 で、一つ下
 test2 で、一つおき となっているはずです。


Sub 並べ替え()
  
  Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin, DataOption1:=xlSortNormal
  
End Sub

Sub test1()   'すぐ下と比べて
  
  Dim i As Integer
  Dim myRow As Long
  Call 並べ替え
  
  myRow = Range("A65536").End(xlUp).Row
  Range("D2:E" & myRow).ClearContents
  For i = 2 To myRow - 1
    With Cells(i, "C")
     If .Value = .Offset(1, 0).Value Then
      .Offset(0, 1).Value = .Offset(0, -1).Value
      Else
      .Offset(0, 2).Value = .Offset(0, -1).Value
      End If
     End With
  Next
End Sub

Sub test2()  '一つ飛びと比べて
  Dim i As Integer
  Dim myRow As Long
  Call 並べ替え
  
  myRow = Range("A65536").End(xlUp).Row
  Range("D2:E" & myRow).ClearContents

  For i = 2 To myRow - 2
    With Cells(i, "C")
     If .Value = .Offset(2, 0).Value Then
      .Offset(0, 1).Value = .Offset(0, -1).Value
      Else
      .Offset(0, 2).Value = .Offset(0, -1).Value
      End If
     End With
   Next
  
  
End Sub

2 hits

【27225】値の振り分けです。どうかよろしくお願い... ℃素人 05/8/2(火) 19:51 質問
【27231】Re:値の振り分けです。どうかよろしくお願... ponpon 05/8/3(水) 0:13 発言
【27232】Re:値の振り分けです。どうかよろしくお願... ichinose 05/8/3(水) 0:36 発言
【27233】Re:値の振り分けです。どうかよろしくお願... ponpon 05/8/3(水) 1:02 発言
【27234】どうもありがとうございました!! ℃素人 05/8/3(水) 2:34 お礼

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