2

仕事の義務として、Excel 2003 でスプレッドシートを開き (すぐに新しいコンピューターを入手します...)、1 つのシートを 1 つの ID: Vendor Id # に基づく多くのワークシートを含むドキュメントに分割するように言われました。

ワークシートには 1 行の高さのヘッダーがあります。最初のヘッダー列は「VendorID」です。現在、ここには各列に多数の他のヘッダーがあり、それらには方程式が含まれています。シートをベンダー ID の名前にしたい。

私が欲しいのは、次のような多くのシートを取得することです:

「vendorId」の A 列ヘッダーである「00708」というシートには、以下が含まれます。

vendid |  B   |  C   |  D   |
00708  | true | 1.07 | 4.52 |

ほんの一例です。さまざまな情報の列がたくさんあります。たくさんの。

私の問題は、職場で次のコードを試したことです。

Option Explicit
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long


Set wsAll = Worksheets("Sheet1") ' change All to the name of the worksheet the existing data is on

LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row

Set wsCrit = Worksheets.Add

' column A has the criteria eg project ref
wsAll.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To LastRowCrit

    Set wsNew = Worksheets.Add
    wsNew.Name = wsCrit.Range("A2")
    wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
     CopyToRange:=wsNew.Range("A1"), Unique:=False
    wsCrit.Rows(2).Delete

Next I

Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End Sub

問題は、このコードが美しく機能することです....もっと右にスクロールして、適切に移動されたままの列の多くに、以前の数値だけでなく、因数分解された数値も含まれている空白が含まれていることに気付きました。ただし、Excel の数式 (隣のセルの値を加算するようなもの)

基本的に....これには決定的なコードはありませんか？私は何時間も Web を検索しましたが、私が試したコードはどれも、覚えていなくて申し訳ありませんでした。上記のコードが機能したことは間違いありませんが、重要な情報と方程式を出力し、それらを空白にしました。

私は〜8000行あり、Excelで65,000行程度のことができることを知っています。隅から隅までの領域を取得しようとするコードを見たことがありますが、それは必要ありません。すべての列とすべての行を取得するコードが必要です...情報の最初の「タイプ」(この場合はベンダー ID) の最初の値を見て、(この同じドキュメント内に) できるだけ多くの新しいシートを作成します。異なるベンダー ID ごとに 1 つ作成する必要があります。

どんな助けでも大歓迎です。できるだけ手作業で行う必要がないようにしています。

4

0 に答える 0