0

https://dl.dropbox.com/u/3327208/Excel/copydown.xlsx

ドロップボックスが表示できない場合のシートです。 ここに画像の説明を入力してください

これはワークブックです。私が探しているのは、3Mが表示されている場所で、会社のタイトルを列Aの合計が表示されている場所にコピーして、次の会社でも同じことを行うことです。

Excel VBAでこれを行うにはどうすればよいですか？私は最後の行を使用できることを知っていますが、元のバージョンには300以上の異なる会社があるため、これは私が信じる最善の方法ではありません。

これが私が今使っている元のコードです。に余分なビットを追加せずに。

オプション明示

Sub Import()

    Dim lastrow As Long
    Dim wsIMP As Worksheet 'Import
    Dim wsTOT As Worksheet 'Total
    Dim wsSHI As Worksheet 'Shipped
    Dim wsEST As Worksheet 'Estimate
    Dim wsISS As Worksheet 'Issued
    Dim Shift As Range


    Set wsIMP = Sheets("Import")
    Set wsTOT = Sheets("Total")
    Set wsSHI = Sheets("Shipped")
    Set wsEST = Sheets("Estimate")
    Set wsISS = Sheets("Issued")

    With wsIMP

        wsIMP.Range("E6").Cut wsIMP.Range("E5")
        wsIMP.Range("B7:G7").Delete xlShiftUp

End Sub
4

2 に答える 2

1

マット、私はこの数か月前に素晴らしい機能を持っていましたが、ライブラリにコピーするのを忘れていました。しかし、私は以前に持っていたもののかなり良いモックアップを作成しました。（何らかの理由でピボットテーブルのエントリを入力するために使用していました）。

とにかく、ここにあります。正確なニーズを満たすために微調整する必要があるかもしれません。現時点でエラーが発生しにくいとは言いませんが、すばらしいスタートになるはずです。

編集=コード投稿を更新して、コード投稿に統合し、簡単にできるようにしました。 

    Sub Import()

    Dim lastrow As Long
    Dim wsIMP As Worksheet, wsTOT As Worksheet 'Total
    Dim wsSHI As Worksheet, wsEST As Worksheet 'Estimate
    Dim wsISS As Worksheet, Shift As Range


    Set wsIMP = Sheets("Import")
    Set wsTOT = Sheets("Total")
    Set wsSHI = Sheets("Shipped")
    Set wsEST = Sheets("Estimate")
    Set wsISS = Sheets("Issued")

    With wsIMP

        .Range("E6").Cut .Range("E5")
        .Range("B7:G7").Delete xlShiftUp

        Call FillDown(.Range("A1"), "B")

        '-> more code here

    End With


End Sub

Sub FillDown(begRng As Range, col As String)

Dim rowLast As Long, rngStart As Range, rngEnd As Range

rowLast = Range(col & Rows.Count).End(xlUp).Row
Set rngStart = begRng

Do

    If rngStart.End(xlDown).Row < rowLast Then
        Set rngEnd = rngStart.End(xlDown).Offset(-1)
    Else
        Set rngEnd = Cells(rowLast, rngStart.Column)
    End If

    Range(rngStart, rngEnd).FillDown
    Set rngStart = rngStart.End(xlDown)

Loop Until rngStart.Row = rowLast


End Sub

enter code here
于 2012-08-24T15:13:34.040 に答える
1

上書きしたくない数式がない限り...

編集-列Bの終わりに基づいて元の範囲を設定するように更新されました

Sub Macro1()
    Dim sht as WorkSheet

    Set sht = ActiveSheet

    With sht.Range(sht.Range("A7"), _
                   sht.Cells(Rows.Count, 2).End(xlUp).Offset(0, -1))

        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value

    End With    
End Sub
于 2012-08-24T15:49:24.950 に答える