0

ブックから特定の列のセットを読み取って（毎週新しいブックです）、それらを別のブックにコピーしようとしています。これはできましたが、もっときれいな方法があると思います!! 私のコードは非常にかさばり、問題があります。毎週、別のワークブックから情報を読み取る必要があるため、コードに戻ってワークブックのファイル名を変更する必要があります。コードを改善し、列のコピー元のブックのファイル名の変更を高速化する方法についての入力が欲しいです。たとえば、静的な名前の代わりにファイル名を入力するようにユーザーに求めることは可能です。 ??

フィードバック/提案は大歓迎です!!! 私のコードは以下の通りです：

Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range


Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")


sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub
4

4 に答える 4

0

次の単純なコードを使用して、名前と数を知らなくても、フォルダー内のすべてのファイルをループすることができます。

LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop

ファイルマスクではワイルドカードを使用できます。幸運を！

于 2013-02-03T19:21:50.187 に答える
0

ユーザー入力をきちんと受け取る簡単な方法は、InputBox関数を使用することです

Sub ReadInputBox()

    Dim readWorkbookLocation As String
    readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")

    MsgBox workbookFile

End Sub
于 2013-02-03T12:48:32.073 に答える
0

これらのタイプの操作には、vb コードを含む別の Excel ファイルを使用します。(このファイルを「操作」と呼びます)。ワークシートにソース/宛先ファイルの名前を入力します。「ソースの選択」、「宛先の選択」などのボタンを追加して、ファイルの入力を求めますが、選択したファイル名をシートにのみ配置します。別のボタン「Go」は、指定されたファイルを使用して実際の操作を行います。

ここに画像の説明を入力

コピーする列がめったに変更されない場合は、VBA 内に残すことができます。時々変更する場合や、複数のバージョンが必要な場合は、Operation ワークシートにも記入してください。より複雑なシナリオが必要な場合は、作成者が列自体を指定できるように、ソース/宛先ワークブックの別のワークシートに構成を配置できます。

コードの提案として、ファイル名に定数/変数を使用して、ファイル名を手動で変更するときの入力を最小限に抑えます。また、操作対象のワークブックとワークシートを変数に割り当てます。

' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet

' SOURCE
Dim srcFN as string

' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"

' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )

Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )

' DESTINATION
.... do the same ...

.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....

.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
    Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
    Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
    srcRange.Copy Destination:=dstRange
    currentRow = currentRow + 1
Wend
于 2013-02-03T17:07:46.097 に答える
0

うん。を使用しApplication.GetOpenFilenameて、ユーザーにファイル名を選択させることができます。例えば

Option Explicit

Sub Sample()
    Dim Ret
    Dim Wb As Workbook
    Dim ws As Worksheet

    Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

    If Ret <> False Then
        Set Wb = Workbooks.Open(Ret)
        Set ws = Wb.Sheets("Sheet1")

        With ws
            '
            '~~> Do whatever you want to do here with the worksheet
            '
        End With
    End If
End Sub

編集：あなたもタグ付けしていることに気付きexcel-vba-macました。Excel 2011 でこれを行っている場合は、Application.GetOpenFilename. 残りのコードはそのままです。

于 2013-02-03T14:34:57.750 に答える