2016-10-25 11 views
0

「ポジション」というExcelの列があります。 列は、このストリング番号が1つの列の行で等しいかどうかを比較する式

体位

1-5

1-7

1-7

1-8

1-89

のような文字列の番号を持つことができます

2-1

2-12

2-2

2-3

..... NN ...最初の番号は、ページ番号とした後、すなわち、二番目の数字を参照しています「 - "はページ位置を参照しています。

ページはちょうどこのように左から右に始まる9箇所に分かれています。あなたが持っているときに

位置欄に1〜8の数字が表示されます。

Page 1

7(8)9

そして、あなたが位置列に番号2-12を有する場合には、意味:

ページ2

(1)(2)3

は、今ではそれが設計される方法ですが、

体位前に述べたように、私は位置のセットを持っているとき私が変更したいと、位置の欄にあるだけで

1-5

1-7

1-7

1-8

1-89

2-1

2-12

2-2

2-3

.....

私は式を必要とします何らかの形で1-8位と1-89位が重なり、2-1位、2-12位と2-2位が重なることを何らかの形で通知する。もちろん、位置1-7と1-7は完全に重なるので、これもユーザーに通知する必要があります。どうすればいい?

答えて

1

OPとして、VBAタグが追加されました。この手順を試してください。 を対応する3 piecesに分割し、リスト内の他のすべてのPositionsと比較します。 PositionsリストがB2から始まり、比較結果を列Cにリストするとします。

'These Options declaration always go at the top of the module, class, etc. 
Option Explicit 
Option Base 1 

Sub Get_Overlap() 
Const kFlag As String = "Overlapping" 'Change as required 
Dim rData As Range, aData As Variant, aResults() As String, sResult As String 
Dim lA As Long, sAvalue As String, iAp As Integer, bA1 As Byte, bA2 As Byte 
Dim lB As Long, sBvalue As String, iBp As Integer, bB1 As Byte, bB2 As Byte 

    Rem Sets Data Range & Arrays 
    With ThisWorkbook.Sheets("TEST").Columns("B") 'Change as required 
     Set rData = Range(.Cells(2), .Cells(Rows.Count).End(xlUp)) 
    End With 
    aData = rData.Value2 
    aData = WorksheetFunction.Transpose(aData) 
    rData.Offset(0, 1).ClearContents 
    ReDim Preserve aResults(UBound(aData)) 

    For lA = 1 To UBound(aData) 

     Rem Initialize & Set Item A Values 
     sAvalue = Empty: sAvalue = aData(lA) 
     iAp = 0: iAp = Left(sAvalue, 1) 
     bA1 = 0: bA1 = Mid(sAvalue, 3, 1) 
     On Error Resume Next 
     bA2 = 0: bA2 = Mid(sAvalue, 4, 1) 
     On Error GoTo 0 

     For lB = lA + 1 To UBound(aData) 

      Rem Initialize & Set Item B Values 
      sBvalue = Empty: sBvalue = aData(lB) 
      iBp = 0: iBp = Left(sBvalue, 1) 
      bB1 = 0: bB1 = Mid(sBvalue, 3, 1) 
      On Error Resume Next 
      bB2 = 0: bB2 = Mid(sBvalue, 4, 1) 
      On Error GoTo 0 

      Rem Initialize Comparison Result 
      sResult = Empty 

      Rem Compare Items & Values 
      Select Case True 
      Case sAvalue = sBvalue 
       sResult = kFlag 

      Case iAp = iBp 
       Select Case True 
       Case bA2 = 0 And bB2 = 0 
        If (bA1 = bB1) Then sResult = kFlag 

       Case bA2 = 0 
        If bA1 >= bB1 And bA1 <= bB2 Then sResult = kFlag 

       Case bB2 = 0 
        If bB1 >= bA1 And bB1 <= bA2 Then sResult = kFlag 

       Case Else 
        If bA1 >= bB1 And bA1 <= bB2 Then 
         sResult = kFlag 
        ElseIf bA2 >= bB1 And bA2 <= bB2 Then 
         sResult = kFlag 
        ElseIf bB1 >= bA1 And bB1 <= bA2 Then 
         sResult = kFlag 
        ElseIf bB2 >= bA1 And bB2 <= bA2 Then 
         sResult = kFlag 
        End If 

      End Select: End Select 

      Rem Add Results into Array 
      If sResult <> Empty Then 
       aResults(lA) = sResult 
       aResults(lB) = sResult 
      End If 

    Next: Next 

    Rem Enter Comparison Results 
    'Results will be posted one column to the right of where the List 
    'This is done by the use of "rData.Offset(0,1)" 
    rData.Offset(0, 1).Value = WorksheetFunction.Transpose(aResults) 

    End Sub 

が使用するリソースのより深い理解を得るためには以下のページを読むことを提案する:

Option keywordVariables & ConstantsWith StatementRange Object (Excel)WorksheetFunction Object (Excel)For...Next StatementSelect Case StatementIf...Then...Else StatementOn Error Statement, Range.Offset Property (Excel)

+0

ありがとうございました!どこのコードで私は列cを定義する必要がありますか?エクセルシートにポジション列がある新しい列が必要なのでしょうか? Option Explicit nadオプションBase 1はそうなるでしょうか? – Hankman3000

+0

これで問題が解決する場合は、\タグを答えとして選択してください – EEM

+0

1.コードは、リストがどこにあるか、つまりリストがBである場合は結果をCに掲載します。 'rData.Offset(0,1)'行目に置き換えます。あなたは何を指しているのか理解していない。オプションの宣言は常にモジュール、クラスなどの最上位にあります*(回答の編集を参照してください)* – EEM

関連する問題