2016-09-08 11 views
0

私はマクロに慣れていません。私は500行のデータを持つB列のデータを持っています。データは、([email protected][email protected][email protected][email protected][email protected])のようなイメージファイル名です。次の列の基準に基づいて、各データを特定の行に移動したい。データ内の数値に基づいてセルデータを各行に移動する

基準は下記のように番号を見つけることでなければならない:

データが[email protected]場合、X00後数1は、データ場合1

の行に移動しなければなりません[email protected]は、X00の後の数字2は、データが[email protected]場合、X00の後の数字3は、データ場合3.

の行に移動しなければならない2.

の行に移動しなければなりません[email protected]です.X0の後の13は、データは[email protected]、データはX00後[email protected]、数41である場合15

の行に移動しなければならないX0後に数15であれば13

の行に移動しなければなりません41.

は私のデータが列Bに表示されている方法を下記参照行に移動し、私はC.

列でそれをしたいどのように誰もがこのためにマクロを提供できる場合、私は感謝しています。

  Col B    Col C 
Row1  [email protected]  [email protected] 
Row2  [email protected]  [email protected] 
Row3  [email protected]  
Row4  [email protected]  [email protected] 
Row5  [email protected]  [email protected] 
Row6  [email protected]  
Row7  [email protected]  [email protected] 
Row8  [email protected]     
Row9   
Row10   
Row11      [email protected] 
Row12      [email protected] 
Row13      
Row14      [email protected] 

ここおかげ

+0

mid(B2; 2; 3)としてmid関数を使用します。その後、番号に変換します。次に、C列の各ピクチャの行番号を取得します。休憩は簡単に処理できるはずです。 –

答えて

1

は、あなたが求めている正確に何をする単純なルーチンです。どのように動作するかは、列Bの各セルについて、Xの後の3桁のみを行として定義します。次に、元のセルの値を対応する行のセルにコピーします。ここで

Sub PicToRow() 
    Dim ws As Worksheet 
    Dim picName As String 
    Dim picRow As Integer 
    Dim picRange As Range 

    Set ws = ThisWorkbook.Sheets(1) 
    Set picRange = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp)) 

    For Each myCell In picRange 
     If myCell.Value <> "" Then 
      picName = Replace(LCase(myCell.Text), "x", "") 'Remove the X 
      picRow = CInt(Replace(picName, "[email protected]", "")) 'Remove the rest 
      ws.Range("C" & picRow).Value = myCell.Value 'Copy data to new cell 
     End If 
    Next myCell 'do it again 
End Sub 
+0

ありがとうございます。しかし、picRow = CInt(Replace(picName、 "[email protected]"、 ""))でエラータイプの不一致が表示されます。 – Siraj

+0

Sirajを修正して問題を修正しました。あるいは、 "x"を "X"にして、 "LCase()"を含まないようにすることもできますが、それは問題ではありません。このコードは私のために働く。私があなたの質問に答えたなら、これを答えにすることができますか?ありがとう! – Tyeler

1
Sub justForYou() 
Dim i As Integer 
With ActiveSheet 
For i = 2 To Range("B1000").End(3).Row 
    .Cells(i, 3) = Mid(.Cells(i, 2), 2, 3) 
    .Cells(i, 3).Copy 
    .Cells(i, 3).PasteSpecial xlValues 
    .Cells(i, 2).Copy 
    .Cells(.Cells(i, 3).Value, 4).PasteSpecial 
Next 

End With 
End Sub 

あなたのためのシンプルなソリューションです。

関連する問題