セル内容に基づいてセルを新しいシートに移動するためのVBAマクロ

StackOverflow https://stackoverflow.com//questions/25069593

  •  26-12-2019
  •  | 
  •  

質問

私は見回し、必要な特定の対応を見つけることができなかった。だから私は尋ねます。 私は列Aにのみデータを含むシート（シート1）を持っています。

Enter Image説明

とID、TITL、およびAUTHを含む任意のセルの列Aで検索するVBAマクロを作成する必要があります。 そして別のシートの特定の列に移動します（Sheet2）。 Sheet2には3列があります.ID、タイトル、作者。

セルのデータをSheet2の特定の列にコピーすることとともに、データの最初の部分を削除する必要があります。例えば： ID：Sheet1のR564838は、「ID：」なしで、Sheet2のID列に移動する必要があります。だからR564838だけを動かす必要があるでしょう。 コピーしたときに「TITL：」と「AUTH：」を削除する必要があります。

これが理にかなっていることを願っています。私はただVBAマクロを学ぶことです。だから私はこれをどのように達成するかわかりません。

更新

このコードを持っています：

Sub MoveOver() 

Cells(1, 1).Activate 


While Not ActiveCell = "" 

    If UCase(Left(ActiveCell, 4)) = "  ID" Then Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move ID to Col A in sheet 2

    If UCase(Left(ActiveCell, 4)) = "TITL" Then Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move TITL to Col B in sheet 2

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move AUTH to Col C in sheet 2

    ActiveCell.Offset(1, 0).Activate 

Wend
.

終了SUB

の作品。しかし、空白のシート1にはいくつかの認証とTITLがあります。そして、状況は、これが実行されると、AUTHまたはTITLが空白の場合は空のセルを残しません。 AUTHまたはTITLが空白の場合は空のセルを残す必要がありますので、情報は各本に一致します。 私はあなたが私の問題を理解することを願っています。

もう一度ありがとうございました！

役に立ちましたか？

解決

右のワークブック/シート/列に作業していることを確認するためにいくつかの変数を設定します。

Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
col = 1
.

列の最後のセルを見つける

last1 = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row
.

各セルを見て、それをどうするべきかを把握する

For x = 1 To last1
    'What you do with each cell goes here
Next x
.

セルの内容を評価する（それが特別なものが含まれているかどうか知っている）

If ws1.Cells(x, col) Like "*ID:*" Then
    'What you do with a cell that has "ID:" in it
End If
.

セルの目的の内容を抽出する（「ヘッダ」を取り除く）

myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))
.

次の2枚目のシートの次の行にコンテンツを配置します（IDが列に入ると仮定します）

current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID
.

コードのビットをまとめてあなたの正確なニーズに合わせる方法を見つけてください！

あなたのコメントに答えて：

基本的にはい、しかし、あなたはあなたの特定の状況を完全に包括的ではないので、あなたはある程度の問題にぶつかるかもしれません。あなたがしなければならないのは：

  1. 変数にID（1つが見つかったら）を保存します。
  2. タイトルと著者のために同じことをする
  3. 区切り回線を見つけたら、代わりに変数の現在の内容を次の利用可能な行に書き込み、それらの変数の内容を空にします。

    4. 例えば：

    If ws1.cells(x, col) Like "*----*" Then
    current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
    ws2.Cells(current2, 1) = myID
    ws2.Cells(current2, 2) = myTitle
    ws2.Cells(current2, 3) = myAuthor
    myID = ""
    myTitle = ""
    myAuthor = ""
End If
    .

    ここに行きます:) 

    Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

    If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If ActiveCell Like "*---*" Then
        'NOW, MOVE TO SHEET2!
        toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        Sheets(2).Cells(toRow, 1) = myId
        Sheets(2).Cells(toRow, 2) = myTitle
        Sheets(2).Cells(toRow, 3) = myAuthor
        myId = ""
        myTitle = ""
        myAuthor = ""
    End If

    ActiveCell.Offset(1, 0).Activate

Wend
    .

    あなたが私が変更したものを理解するのに助けが必要な場合は、私に知らせてください、しかしそれはかなり前方にあるべきです！

他のヒント

a：区切り文字として列にテキストを実行してみてください。それはあなたの情報を1ではなく2列に与えるでしょう、それからあなたはヘッダーのために1列を検索し、次の列値、空白またはそうでなければコピーすることができます

ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top