1

私が持っているのは、データの形式が比較的同じである100を超えるタブを持つスプレッドシートですが、一部のシートは他のシートよりも行数が多いまたは少ないです。すべての従業員番号と名前を含む EMP_NUMという名前のシートがあります。すべての関連データをマスターシートにコピーしたいマスター シートがあります。シートEMP_NUMに記載されている従業員番号は、100 以上のシートの名前と一致します。最後に、マスターシートの各行の最初のセルを従業員番号にし、行の残りのセルを他のすべてのシートから収集したデータにします。

コピーする必要があるemployee#シートのデータは、A4 から始まり、TX で終わります。ここで、X は、列 A でまだ値が残っている最大の行番号に等しくなります。

EMP_NUMのデータを使用してプロシージャで呼び出され、データが一致するためデータをコピーするための正しいシートを見つけるだけでなく、行の最初のセルとしても使用することを考えていました。

完了したら、数式を追加してデータを計算できます。Excel で VB を少しだけ試してから 6 年以上経ちましたが、どうすればよいかわかりません。お世話になりました！何かをクリアする必要がある場合はお知らせください。

**追加した**

最初のステップは、データをコピーする最初のシートを見つけることだと思います。最初のシートを見つけるには、関数はEMP_NUMシートに移動し、最初の番号が何であるかを確認する必要があります。その番号は、必要なシートの名前に正確に関連しています。それはintEmpNumにすることができます

次に、対応するシートで、4 行目以降にデータがある行数を計算します。これらの行は、コピーする範囲になります。この範囲をシートマスターの最初の使用可能な行にコピーし、列 B から開始して、列 A を空白のままにします。列 A は、列 B にデータがあるが列 A にはないすべての行のintEmpNumです。

次に、EMP_NUM で次の従業員番号を見つけ、シートEmp_NUMの列 A に従業員番号がなくなるまでプロセスを繰り返します。

これは私がこれまでに持っているものです -

Sub Button1_Click()    
Dim intEmpNum As Integer 'employee number
    Dim strEmpCell As String 'row that employee number is in 
    strEmpCell = 1
    Do Until Sheets("EMP_NUM").Range("A" + strEmpCell).Value = 0
        intEmpNum = Sheets("EMP_NUM").Range("A" + strEmpCell).Value
        strEmpCell = strEmpCell + 1
    Loop
        MsgBox ("The value was not found!")
End Sub
4

2 に答える 2

0

最近、1回限りのプロジェクトでVBAを選択しました。作業を小さなタスクに分割します。

シートwnで指定されたNAMEを見つける方法は次のとおりです。

Dim wn as String
Dim COLUMN_WHERE_ID_IS as String

COLUMN_WHERE_ID_IS = "B" 
For srow = 1 To Worksheets(wn).Range("B65536").End(xlUp).row
 If (Worksheets(wn).Range(COLUMN_WHERE_ID_IS & srow & ":" & COLUMN_WHERE_ID_IS & srow).Value = NAME) Then
     '' copy stuff to target you have range now
 Exit For
End If
Next srow

次に、すべてのセルを調べてNAMEを取得する関数を作成し、上記のサブルーチンを呼び出します。次に、すべてのシートをループする方法を見つける必要があります。

それはひどく効果がないことに注意してください。アルゴリズムの観点から、すべてのEMP NUMをSet構造体に配置し、いずれかのシートを調べるときにset.contains（_empnum）かどうかを確認する必要があります。

于 2010-10-27T21:19:31.777 に答える
0

これまでのコードに関して、あなたは正しい考えを持っていると思います。しかし、従業員番号のリストを設定する代わりに動的範囲名を使用することを検討します。したがって、範囲名として持っている可能性があります。

次の式を使用して、「EmployeeNum」という名前の新しい範囲を作成します

=OFFSET("EMP_NUM!$A1",0,0,COUNTA("EMP_NUM!$A:$A"),1)

これにより、ループ コードの処理が少し簡単になります。

Sub getEmployeeData()
    Dim rCell As Range
    Dim dblPasteRow As Double

    'Start pasting in first row

    For Each rCell In Range("EmployeeNum")
        dblPasteRow = dblPasteRow + CopyData(rCell.Value, dblPasteRow)
    Next rCell
End Sub

コピーを行う関数を使用しています。まず、コードを必要な 2 つの小さなジョブに分割します。次に、関数はデータを返すことができるので、貼り付けたデータの行数を呼び出し元のサブルーチンに知らせることができます。

Function CopyData(strEmpNum As String, dblPasteStart As Double) As Double

    Dim wksEmployee As Worksheet
    Dim dblEndRow As Double

    'If there is an error, we are adding 0 rows
    CopyData = 0
    'Error handling - if sheet isn't found
    On Error GoTo Err_NoSheetFound
    'Set a worksheet object to hold the employee data sheet
    Set wksEmployee = Sheets(strEmpNum)
    On Error GoTo 0

    With wksEmployee
        'Find the last row on the worksheet that has data in column A
        dblEndRow = .Range("A4").End(xlDown).Row
        'Copy data from this sheet
        Range(.Range("A4"), .Range("T" & dblEndRow)).Copy
    End With

    'Paste data to master sheet - offset to column B
    Range(Worksheets("MASTER").Range("B" & dblPasteStart), Worksheets("MASTER").Range("U" & dblPasteStart + dblEndRow)).Paste
    'Write employee numbers next to the data
    Range(Worksheets("MASTER").Range("A" & dblPasteStart), Worksheets("MASTER").Range("A" & dblPasteStart + dblRowEnd)).Value = strEmpNum

    'Let the calling sub know how many rows we added
    CopyData = dblEndRow

    Exit Function
'Only runs if an error is found
Err_NoSheetFound:
    Debug.Print "Can't find employee number: " & strEmpNum

End Function

コードを実行していないため、バグがある可能性があります。少なくとも正しい方向に向けてくれることを願っています。

于 2010-10-29T03:49:46.870 に答える