5

A、B、C の 3 つの列があります。
列 A には、NAME1、NAME2 などの名前が含まれます。
列 B には、値「YES」または「NO」のみが含まれます。
列 C には、列 B に値 "YES" を持つ列 A の名前が含まれていると想定されます。

列Bの値が「YES」である限り、列Aから列Cに値をコピーすると言えます。非常に簡単です：

C1=IF(B1="YES",A1,"")

しかし、これには空白のセルが含まれますが、これは望ましくありません。したがって、列 A のすべての名前を列 B に値「YES」でコピーし、空白をスキップして列 C に貼り付ける方法を探していると思います。

列内のすべてのセルを特定の値で色付けする VBA プロジェクトを見つけました。これを必要なものに編集する方法がわかりません。これが私がこれまでに思いついたコードです。


問題1)ランタイム エラー '1004' アプリケーション定義またはオブジェクト定義のエラー
2)列 A からのコピー
3) NewRangeからの重複の確認と削除

EDIT 1 : コードにコメント行を追加しました
EDIT 2 : NewRange をオフセット付きの列 A から作成するように変更します (実行時エラーのため未テスト)
EDIT 3 : 別のシートに貼り付けるためのコードとは別のシートからコピーするためのコード
EDIT 4 : 追加ユーザー @abahgat からの修正
EDIT 5 : 重複を削除

Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1

'--> Loop through each cell in column B
'--> Add each cell in column A with value "YES" in column B to NewRange 
For Each cell In Worksheets("Sheet1").Range("B1:B30")
    If cell.Value = "YES" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
        Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
        MyCount = MyCount + 1
    End If
Next cell

'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=activesheet.Range("C1")

'--> Remove Duplicates
activesheet.Range("C1:C30").RemoveDuplicates

End Sub
4

3 に答える 3

6

VBA を使用しないソリューション:

列 C には、次のような数式が含まれています。

=COUNTIF(B$1:B1;"yes")

この行の列 B に「はい」の値がある場合、列 C の数値を増やします。
この値は次のステップで使用されます。

列 D には、次のような数式が含まれています。

=INDEX(A:A;MATCH(ROW();C:C;0))

次から値を取得します:
テーブル: 全体 A 行
行番号: 一致関数によって計算: C 列全体で最初に出現する行番号 (値を配置する行番号) を検索します。0 は、最も近い数ではなく、正確にこの数を探していることを意味します。

エラーをスキップするには:

=IF(ISERROR(MATCH(ROW();C:C;0));"";INDEX(A:A;MATCH(ROW();C:C;0)))

簡単に書くことができます:

=IFERROR(INDEX(A:A;MATCH(ROW();C:C;0));"")

つまり、この値がエラーでない場合はルールから値を書き込み、ルールがエラーの場合は空の文字列を書き込みます

于 2013-07-18T09:05:33.493 に答える
2

空のセルを避けるためにAnd条件を使用しましたIf

  1. でC1、入れてからコピーします=IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
  2. 選択するcolumn C
    • F5を押します
    • 特別な...チェックFormulasしてから、エラーにチェックマークを付けます（写真を参照）
    • 選択したセルを削除して、列 C に目的の名前の短いリストを残します。

ここに画像の説明を入力

于 2012-11-20T09:40:17.197 に答える
1

これはトリックを行います：

Sub RangeCopyPaste()
  Dim cell As Range
  Dim NewRange As Range
  Dim MyCount As Long
  MyCount = 1

  For Each cell In Worksheets("Sheet1").Range("B1:B30")
      If cell.Value = "YES" Then
          If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
          Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
          MyCount = MyCount + 1
      End If
  Next cell

  NewRange.Copy Destination:=activesheet.Range("D1")

End Sub
于 2012-11-23T14:22:39.917 に答える