2

私は複数の販売ワークシートを持っており、販売員はとりわけ、特定の販売に対する信頼水準を示しています。私はVBAを学び始めたばかりなので、無知ではありませんが、これは私の頭上にあることを認めなければなりません。

行の信頼水準が60％を超える場合は、行全体を新しいワークシートにコピーします。

データは行8から始まり、信頼度の列は列Vです。

VBAスクリプトを適用するワークシートは全部で9つあり、名前は次のとおりです。

  • ジェフ
  • ジョン
  • ティム
  • ピート
  • チャド
  • ボブ
  • ケビン
  • マイク
  • 明細書

信頼水準が60％を超えるすべての行を、マスターシートまたは「インストール」シートにコピーして、もう一度8行目から開始します。「インストール」シートのボタンでスクリプトを実行します。

これが私が取り組んでいるものの写真です：

優れている

4

1 に答える 1

1

以下のコード

  • 9つのシートすべて（名前が存在する場合）から8行目を「インストール」というシートにコピーします
  • 60％未満のレコードは自動フィルタリングされ、マスターシートから削除されます（コピーする前に9枚のシートのそれぞれを自動フィルタリングするよりも効率的です）
  • 行8で「インストール」を開始するために、空白行が上部に追加されます

*行1から7までのヘッダー行が必要な場合は、セールスマンシートの1つからコピーできます-お知らせください*

Sub QuickCombine()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim strShts()
Dim strWs As Variant
Dim lngCalc As Long

With Application
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With

Set ws1 = Sheets("Install")
ws1.UsedRange.Cells.Clear

strShts = Array("Jeff", "John", "Tim", "Pete", "Chad", "Bob", "Kevin", "Mike", "Bill")
For Each strWs In strShts
On Error Resume Next
Set ws2 = Sheets(strWs)
On Error GoTo 0
If Not ws2 Is Nothing Then
Set rng1 = ws2.Range(ws2.[v8], ws2.Cells(Rows.Count, "v").End(xlUp))
rng1.EntireRow.Copy ws1.Cells(ws1.Cells(Rows.Count, "v").End(xlUp).Offset(1, 0).Row, "A")
End If
Set ws2 = Nothing
Next
With ws1
    .[v1] = "dummy"
    .Columns("V").AutoFilter Field:=1, Criteria1:="<60%"
    .Rows.Delete
.Rows("1:7").Insert
End With
With Application
.ScreenUpdating = True
.Calculation = lngCalc
End With
End Sub
于 2012-06-25T00:35:46.540 に答える