用vba/excel/c將工作表分成多個文件的解決方案＃

Question

我想將工作表分成多個文件。

我有一個約10,000行的工作表。有花哨的格式，條件格式，漂亮的顏色，我想保留所有這些屬性。

我需要將此工作表分開。

輸入將是：

+-------+----+----+----+----+ 
| Alex | 45 | 6 | 23 | 56 | 
| Alex | 61 | 47 | 56 | 56 | 
| Liza | 49 | 70 | 34 | 37 | 
| Alex | 33 | 30 | 22 | 39 | 
| Tommy | | 66 | 62 | 29 | 
| Liza | | 38 | 49 | 80 | 
| Alex | 23 | 56 | 56 | 39 | 
| Liza | 32 | 46 | 40 | 43 | 
| Liza | | 90 | 24 | 38 | 
| Tommy | 38 | 10 | 52 | 23 | 
| Nancy | 35 | 36 | 23 | 25 | 
+-------+----+----+----+----+ 

，輸出會是這樣單獨的文件（請記住，我要保留所有花哨的格式，因此該解決方案已與Excel直接工作，不只有CSV（CSV因爲不能保留格式））

終端產品：

+------+----+----+----+----+ 
|  | | | | | 
| Alex | 45 | 6 | 23 | 56 | 
| Alex | 61 | 47 | 56 | 56 | 
| Alex | 33 | 30 | 22 | 39 | 
| Alex | 23 | 56 | 56 | 39 | 
+------+----+----+----+----+ 

和

+------+----+----+----+----+ 
|  | | | | | 
| Liza | 49 | 70 | 34 | 37 | 
| Liza | | 38 | 49 | 80 | 
| Liza | 32 | 46 | 40 | 43 | 
| Liza | | 90 | 24 | 38 | 
+------+----+----+----+----+ 

和

+-------+----+----+----+----+ 
|  | | | | | 
| Nancy | 35 | 36 | 23 | 25 | 
+-------+----+----+----+----+ 

和

+-------+----+----+----+----+ 
|  | | | | | 
| Tommy | | 66 | 62 | 29 | 
| Tommy | 38 | 10 | 52 | 23 | 
+-------+----+----+----+----+ 

的溶液可以是VBA/.NET的組合。請注意，我需要多個文件作爲輸出。

什麼是最快捷的方式來得到這個工作？非常感謝任何輸入！

請注意，這是2007年Excel和後來

Answer 1

由於的Excel格式通常是在一個**一個很大的痛苦，我會建議嘗試以下解決方案：

1. 計算和存儲所有獨特的鑰匙。
2. 爲每個密鑰創建一個文件副本（如file_Alex.xls[x]，file_Liza.xls[x]等）。
3. 處理每個文件，刪除所有非關鍵行，從而留下所有關鍵條目。另外，因爲您只刪除整行，所有文件中的格式都將保留。

這是非常未經優化的，也是非常簡單的解決方案。如果這是一項一次性工作，它應該做得很好。

Answer 2

我以前做過這個。

您可以使用此代碼：

Option Explicit 

Sub getInformations() 

Dim varName As String 

Application.ScreenUpdating = False 
'Replace Tabelle1 with the name of your sheet where the Informations are 
Worksheets("Tabelle1").Select 
Worksheets("Tabelle1").Copy After:=Sheets("Tabelle1") 
Sheets("Tabelle1 (2)").Select 
Sheets("Tabelle1 (2)").Name = "Temp" 
Do Until Range("A1").Value = vbNullString 
    varName = Range("A1").Value 
    Workbooks.Add 
    'Change the Path where you want to save the File 
    ActiveWorkbook.SaveAs ("C:\Documents and Settings\vgellhom\Desktop\" & varName & ".xls") 
    'Change The Name of the Excel Workbopk to the Name of the Workbook with the Names 
    Workbooks("Data.xls").Activate 
    Sheets("Temp").Select 
    varName = Range("A1").Value 

    Do While True 
     Cells.Find(What:=varName).Activate 
     Range(ActiveCell.Row & ":" & ActiveCell.Row).Select 
     Selection.Copy 
     Workbooks(varName & ".xls").Activate 
     ActiveSheet.Paste 
     ActiveCell.Offset(1, 0).Activate 
     'Change The Name of the Excel Workbopk to the Name of the Workbook with the Names 
     Workbooks("Data.xls").Activate 
     Sheets("Temp").Select 
     Selection.Delete Shift:=xlUp 
     If Not Cells.FindNext(After:=ActiveCell) Is Nothing Then 
      Cells.Find(What:=varName).Activate 
     Else 
      Exit Do 
     End If 
    Loop 
    Workbooks(varName & ".xls").Activate 
    'Change the Path where you want to save the File 
    Application.DisplayAlerts = False 
    ActiveWorkbook.Save 
    Application.DisplayAlerts = True 

    Workbooks(varName & ".xls").Close 
Loop 
Application.DisplayAlerts = False 
Sheets("Temp").Delete 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
End Sub 

希望幫助你...