2017-05-09 3 views
0

私たちのチーム名簿では、特定の日に離れている人の移動を取り除こうとしています。例えば、 2017年5月25日のエントリのスクリーンショットでは、Leoは離れています。上記の行で使用できる式/オプション/コードは何ですか?この「空き」列の手動入力に基づいて、すべてのレオのシフトが自動的に削除されます。ここでExcelのクエリ - 列の値を削除する

This is the link to the screenshot of roster

+0

'away'行は手動で入力されていますが、正しいですか? –

+0

はい、空になっている行は手動でJosanに読み込まれます。ありがとう。 – user3839914

+0

上記の現在の行にはどのような数式などがありますか?または、ハードコーディングされた値である場合は、それらを式で置き換えることは難しいでしょう(ただし、元の行に加えて "離れた"行に基づいて新しい行を生成することは可能でしょう) – YowE3K

答えて

1

エクセルVBAを使用して可能な解決策です。

最初に、元の名簿(「マスター」という名前)の内容が新しいワークシート「更新された名簿」にコピーされます。これにより、後でを「離れて」行から削除し、更新プログラムを再適用する必要が生じた場合に、元の名簿の変更されていないコピーを保持できます。

次に、最初の列をスキャンして、「離れています」行を探します。

最後に、残りの各列について、「離れた」名前のリストが配列にロードされます。

次に、「離れた」名前はそれぞれ一度に1つずつ処理されます。名前の各出現は、正規表現と照合して、必要に応じてカンマまたは空白のいずれかに置き換えることによって、名簿の各行から削除されます。

Option Explicit 

Dim AwayRowNbr As Long 

Sub UpdateRoster() 

    Dim UpdatedRoster As Worksheet 
    Dim RowNbr As Long 
    Dim ColNbr As Long 
    Dim MaxColNbr As Long 
    Dim MaxRowNbr As Long 

    ' Insert new "Updated Roster" worksheet 
    Set UpdatedRoster = Sheets.Add(After:=Sheets(Sheets.Count)) 
    UpdatedRoster.Name = "Updated Roster" 

    With ThisWorkbook.Worksheets("Updated Roster") 

    ' Copy contents of "Master" worksheet to "Updated Roster" 
    ThisWorkbook.Worksheets("Master").Cells.Copy Destination:=.Cells 

    ' Locate "Away" row, and determine last column with data 
    AwayRowNbr = .Range("A:A").Find(What:="Away:", LookIn:=xlValues).Row 
    MaxColNbr = .Cells(AwayRowNbr, Columns.Count).End(xlToLeft).Column 

    For ColNbr = 2 To MaxColNbr 
     Call RemoveNames(.Cells(AwayRowNbr, ColNbr).Value, ColNbr) 
    Next ColNbr 

    End With 

End Sub 

Sub RemoveNames(AwayNames As String, ColNbr As Long) 

    Dim AwayName() As String 
    Dim Name As String 
    Dim NameIdx As Integer 
    Dim RegEx As Object 
    Dim RowNbr As Long 
    Dim MaxRowNbr As Long 
    Dim BeforeReplace As String 
    Dim AfterReplace As String 

    With ThisWorkbook.Worksheets("Updated Roster") 

    ' Create regular expression object 
    Set RegEx = CreateObject("vbscript.regexp") 
    RegEx.Global = False 

    ' Load "away" names into a String array 
    AwayName() = Split(AwayNames, ",") 

    ' Determine last row with data 
    MaxRowNbr = .Cells(Rows.Count, ColNbr).End(xlUp).Row 

    ' Process each "away" name 
    For NameIdx = LBound(AwayName) To UBound(AwayName) 
     Name = Trim(AwayName(NameIdx)) 
     For RowNbr = 2 To MaxRowNbr 
     If RowNbr <> AwayRowNbr Then 

      AfterReplace = .Cells(RowNbr, ColNbr).Value 

      ' Remove name if delimited by commas 
      RegEx.Pattern = ", *" & Name & " *," 
      Do 
      BeforeReplace = AfterReplace 
      AfterReplace = RegEx.Replace(BeforeReplace, ",") 
      Loop Until BeforeReplace = AfterReplace 

      ' Remove name if at beginning or end of cell 
      RegEx.Pattern = "(^ *" & Name & " *,)|(, *" & Name & " *$)|(^ *" & Name & " *$)" 
      Do 
      BeforeReplace = AfterReplace 
      AfterReplace = RegEx.Replace(BeforeReplace, "") 
      Loop Until BeforeReplace = AfterReplace 

      .Cells(RowNbr, ColNbr).Value = AfterReplace 

     End If 
     Next RowNbr 
    Next NameIdx 

    End With 

End Sub 
関連する問題