Excel VBA質問箱 IV

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

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


51986 / 76732 ←次へ | 前へ→

【29594】Re:値の振り分けです。よろしくお願いします...
回答  Hirofumi  - 05/10/8(土) 20:53 -

引用なし
パスワード
   上手く行かなかったらゴメン
疑問に思うのは、
>same,different列には何も記載しない(スペース)と追加したいのです。
スペースを入れる事と、何もし無い事とは違うんですけど?

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntResult As Variant
  Dim vntStep As Variant
  Dim strProm As String
  
  vntStep = Application.InputBox("比較する試行前入力", , , , , , , 1)
  If VarType(vntStep) = vbBoolean Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If
  
  'Listの左上隅を基準とする(列見出しがある物とします)
  Set rngList = ActiveSheet.Cells(1, "A")
  With rngList
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    If lngRows <= 1 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '項目1、項目2を配列に取得
    vntData = .Offset(1, 1).Resize(lngRows, 2).Value
  End With
  '結果用配列を確保
  ReDim vntResult(1 To lngRows, 1 To 2)
  
  For i = 1 To lngRows - vntStep
    '項目2がスペースの試行で無ければ
    If Trim(vntData(i, 2)) <> "" Then
      'n試行前がA,Bでなくスペースで無ければ
      If Trim(vntData(i + vntStep, 2)) <> "" Then
        '項目2において,n試行前と比較し,同じであれば
        If vntData(i, 2) = vntData(i + vntStep, 2) Then
          vntResult(i, 1) = vntData(i, 1)
        Else
          vntResult(i, 2) = vntData(i, 1)
        End If
'      Else
'        'スペースを入れる
'        vntResult(i, 2) = " "
      End If
'    Else
'      'スペースを入れる
'      vntResult(i, 1) = " "
    End If
  Next i
  
  Application.ScreenUpdating = False
  
  '結果を出力
  rngList.Offset(1, 3).Resize(lngRows, 2).Value = vntResult
  
  Application.ScreenUpdating = True
  
  strProm = "処理が完了しました"
  
Wayout:

  Set rngList = Nothing
  
  Beep
  MsgBox strProm

End Sub
1 hits

【29593】値の振り分けです。よろしくお願いします... ℃素人 05/10/8(土) 18:56 質問
【29594】Re:値の振り分けです。よろしくお願いしま... Hirofumi 05/10/8(土) 20:53 回答
【29595】Re:値の振り分けです。よろしくお願いしま... Hirofumi 05/10/8(土) 21:10 発言
【29618】Re:値の振り分けです。よろしくお願いし... ℃素人 05/10/9(日) 16:27 お礼
【29596】Re:値の振り分けです。よろしくお願いしま... ichinose 05/10/8(土) 22:43 発言
【29619】Re:値の振り分けです。よろしくお願いし... ℃素人 05/10/9(日) 16:41 お礼
【29624】Re:値の振り分けです。よろしくお願いし... ichinose 05/10/9(日) 18:06 発言
【29667】Re:値の振り分けです。よろしくお願いし... ℃素人 05/10/11(火) 12:20 お礼

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