Note: The other languages of the website are Google-translated. Back to English
English English

วิธีสร้างแผ่นงานใหม่สำหรับแต่ละแถวใน Excel

สมมติว่าคุณมีตารางคะแนนที่มีชื่อนักเรียนทุกคนในคอลัมน์ A ตอนนี้คุณต้องการสร้างแผ่นงานใหม่ตามชื่อเหล่านี้ในคอลัมน์ A และทำให้แต่ละแผ่นมีข้อมูลของนักเรียนที่ไม่ซ้ำกัน หรือเพียงแค่สร้างแผ่นงานใหม่สำหรับแต่ละแถวในตารางโดยไม่ต้องคำนึงถึงชื่อในคอลัมน์ A ในวิดีโอนี้ คุณจะได้รับวิธีการต่างๆ

สร้างแผ่นงานใหม่สำหรับแต่ละแถวด้วยรหัส VBA
สร้างแผ่นงานใหม่สำหรับแต่ละแถวด้วยยูทิลิตี้ Split Data ของ Kutools for Excel


สร้างแผ่นงานใหม่สำหรับแต่ละแถวด้วยรหัส VBA

ด้วยรหัสต่อไปนี้คุณสามารถสร้างแผ่นงานใหม่ตามค่าคอลัมน์หรือสร้างแผ่นงานใหม่สำหรับแต่ละแถวใน Excel

1 กด อื่น ๆ + F11 พร้อมกันเพื่อเปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างคลิก สิ่งที่ใส่เข้าไป > โมดูล. จากนั้นวางรหัสต่อไปนี้ลงในไฟล์ โมดูล หน้าต่าง

รหัส VBA: สร้างแผ่นงานใหม่สำหรับแต่ละแถวตามคอลัมน์

Sub parse_data()
'Update by Extendoffice 2018/3/2
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Set xSht = ActiveSheet
    On Error Resume Next
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
    xTitle = "A1:C1"
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For I = 2 To xRCount
        Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For I = 1 To xCol.Count
        Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = CStr(xCol.Item(I))
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
    Next
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
End Sub

หมายเหตุ: A1: C1 คือช่วงหัวเรื่องของตารางของคุณ คุณสามารถเปลี่ยนแปลงได้ตามความต้องการของคุณ

3 กด F5 คีย์เพื่อเรียกใช้รหัสจากนั้นแผ่นงานใหม่จะถูกสร้างขึ้นหลังจากแผ่นงานทั้งหมดของสมุดงานปัจจุบันดังภาพหน้าจอด้านล่าง:

หากคุณต้องการสร้างแผ่นงานใหม่สำหรับแต่ละแถวโดยตรงโดยไม่ต้องพิจารณาค่าคอลัมน์คุณสามารถใช้รหัสต่อไปนี้

รหัส VBA: สร้างแผ่นงานใหม่สำหรับแต่ละแถวโดยตรง

Sub RowToSheet()
	Dim xRow As Long
	Dim I As Long
	With ActiveSheet
		xRow = .Range("A" & Rows.Count).End(xlUp).Row
		For I = 1 To xRow
			Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
			.Rows(I).Copy Sheets("Row " & I).Range("A1")
		Next I
	End With
End Sub

หลังจากรันโค้ดแล้วแต่ละแถวในแผ่นงานที่ใช้งานจะถูกวางไว้ในแผ่นงานใหม่

หมายเหตุ: แถวหัวเรื่องจะถูกวางไว้ในแผ่นงานใหม่ด้วยรหัส VBA นี้


สร้างแผ่นงานใหม่สำหรับแต่ละแถวด้วยยูทิลิตี้ Split Data ของ Kutools for Excel

อันที่จริงวิธีการข้างต้นซับซ้อนและเข้าใจยาก ในส่วนนี้เราจะแนะนำไฟล์ แยกข้อมูล ประโยชน์ของ Kutools สำหรับ Excel.

ก่อนที่จะใช้ Kutools สำหรับ Excelโปรด ดาวน์โหลดและติดตั้งในตอนแรก.

1. เลือกตารางที่คุณต้องใช้ในการสร้างแผ่นงานใหม่จากนั้นคลิก Kutools พลัส> คายข้อมูล. ดูภาพหน้าจอ:

2 ใน แยกข้อมูลออกเป็นหลายแผ่นงาน โปรดทำดังนี้

A. สำหรับการสร้างแผ่นงานใหม่ตามค่าคอลัมน์:

1). โปรดเลือกไฟล์ คอลัมน์เฉพาะ และระบุคอลัมน์ที่คุณต้องการแยกข้อมูลตามในรายการดรอปดาวน์
2). หากคุณต้องการตั้งชื่อแผ่นงานด้วยค่าคอลัมน์โปรดเลือก ค่าของคอลัมน์ ใน กฎระเบียบ รายการแบบหล่นลง
3). คลิก OK ปุ่ม. ดูภาพหน้าจอ:

B. สำหรับการสร้างแผ่นงานใหม่โดยตรงสำหรับแต่ละแถว:

1). เลือก แถวคงที่ ตัวเลือกป้อนหมายเลข 1 ลงในกล่อง;
2). เลือก หมายเลขแถว จาก กฎระเบียบ รายการแบบหล่นลง
3). คลิก OK ปุ่ม. ดูภาพหน้าจอ:

สมุดงานใหม่ถูกสร้างขึ้นโดยมีแผ่นงานใหม่ทั้งหมดอยู่ภายใน ดูภาพหน้าจอด้านล่าง

การสร้างแผ่นงานใหม่สำหรับแต่ละแถวตามค่าคอลัมน์:

การสร้างแผ่นงานใหม่สำหรับแต่ละแถวโดยไม่ต้องพิจารณาค่าคอลัมน์:

  หากคุณต้องการทดลองใช้ยูทิลิตีนี้ฟรี (30 วัน) กรุณาคลิกเพื่อดาวน์โหลดแล้วไปใช้การดำเนินการตามขั้นตอนข้างต้น

สร้างแผ่นงานใหม่สำหรับแต่ละแถวด้วยยูทิลิตี้ Split Data ของ Kutools for Excel


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (32)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการสร้างเวิร์กชีตโดยใช้ไฟล์เทมเพลต Myformat และตั้งชื่อตามข้อมูลคอลัมน์แรก ฉันปรับแต่งโค้ด VBA ดังต่อไปนี้ แต่มันกำลังสร้างแผ่นงานเปล่ามากเกินไป โปรดช่วยฉันหยุดสร้างแผ่นงานเปล่า ขอขอบคุณ. Kumar Sub AddSheets() Dim เซลล์เป็น Excel.Range Dim wsWithSheetNames เป็น Excel.Worksheet Dim wbToAddSheetsTo เป็น Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook สำหรับแต่ละเซลล์ใน wsWithSheetNames.Range("A2:A165") ด้วย wb.ToAddSheetsTo Sheets เพิ่มหลัง:=ActiveSheet Sheets.Add Type:= _ "C:\Users\Dimple\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004 then Debug.Print cell.Value & " ใช้เป็นชื่อชีตแล้ว " End If On Error GoTo 0 End With Next Cell End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
ฉันมักจะได้ 2 แผ่นต่อรายการที่ไม่ซ้ำในแถว A ความคิดใด ๆ ว่าทำไม? นอกจากนี้ การเติมจำนวนแถวทั้งหมดที่แผ่นงานสร้างไว้ข้างหน้าชื่อแผ่นงานจะยากเพียงใด ขอบคุณมาก! แจ้งให้เราทราบหากคุณรับบริจาค
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการใช้ MyFormat เทมเพลตไฟล์ exel เพื่อสร้างเวิร์กชีตและตั้งชื่อเวิร์กชีตตามข้อมูลในคอลัมน์แรก รหัส VBA ต่อไปนี้ทำงานได้ดีเพื่อสร้างแผ่นงานตาม MyFormat แต่มันกำลังสร้างแผ่นเปล่าหลายร้อยแผ่นในเทมเพิล excel ปกติด้วย ได้โปรดช่วยฉันหยุดสร้างแผ่นเปล่าส่วนเกินได้ไหม ขอบคุณ Kumar Sub AddSheets() Dim เซลล์เป็น Excel.Range Dim wsWithSheetNames เป็น Excel.Worksheet Dim wbToAddSheetsTo เป็น Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook สำหรับแต่ละเซลล์ใน wsWithSheetNames.Range("A2:A165") ด้วย wbToAddSheetsTo . .Add After:=ActiveSheet Sheets.Add Type:= _ "C:\Users\Dreamline\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004. จากนั้น Debug.Print cell.Value & " ใช้เป็นชื่อชีตแล้ว " End If On Error GoTo 0 End With Next Cell End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ชื่อเวิร์กชีตต้องมีความยาวน้อยกว่าหรือเท่ากับสามสิบอักขระ
ไม่ใช่ความรู้ทั่วไป แต่มิฉะนั้นโค้ดจะส่งออกเวิร์กชีต "Sheet #" เปล่าที่เป็นค่าเริ่มต้น

สร้างเวิร์กชีตใหม่ที่โค้ดแยกวิเคราะห์ของคุณจะทำงานและอ้างอิงคอลัมน์แรกดังนี้:
=IF(OR('Referenced Original'!B1<>"", LEN('Referenced Original'!B1)>30), LEFT('Referenced Original'!B1,30),'Referenced Original'!B1)


คัดลอกหรืออ้างอิงส่วนที่เหลือของแผ่นงานตามที่คุณอาจทำ ตรวจสอบให้แน่ใจว่าคอลัมน์ไม่มีข้อจำกัดในการตรวจสอบข้อมูล ถ้าคุณมีปัญหาในการอ้างอิงเวิร์กชีตอื่น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมากสำหรับการโพสต์นี้ !!!! ทำงานเหมือนมีเสน่ห์ คุณช่วยอธิบายวิธีการทำงานของรหัสชุดแรกได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณสำหรับสิ่งนี้!



ในโค้ด VBA นั้นมีการตั้งชื่อชีตผลลัพธ์จากข้อมูลแถวของคอลัมน์ที่หนึ่งและสองรวมกันหรือไม่



ดังนั้นสำหรับแผ่นตัวอย่างของคุณ 2 จะมีชื่อว่า "linda 100" โดยอัตโนมัติ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จอยซ์ที่รัก
ขอบคุณจากความคิดเห็นของคุณ! หวังว่าสคริปต์ VBA ด้านล่างจะช่วยคุณได้

ย่อย parse_data()
Dim xRCount ตราบใดที่
Dim xSht เป็นแผ่นงาน
Dim xNSht เป็นเวิร์กชีต
หรี่ฉันนาน
Dim xTRrow เป็นจำนวนเต็ม
Dim xCol เป็นคอลเลกชั่นใหม่
Dim xTitle เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
ตั้งค่า xSht = ActiveSheet
xRCount = xSht.UsedRange.End(xlDown).Row
xTitle = "A1:B1"
xTRrow = xSht.Range(xTitle).Row
สำหรับฉัน = 2 ถึง xRCount
โทร xCol.Add(CStr(xSht.Cells(I, 1)), CStr(xSht.Cells(I, 1)))
ต่อไป
Debug.Print xCol.Count
สำหรับฉัน = 1 ถึง xCol.Count
โทร xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
ตั้งค่า xNSht = Nothing
ตั้งค่า xNSht = แผ่นงาน (CStr(xCol.Item(I)))
ถ้า xNSht ไม่มีอะไรแล้ว
ตั้งค่า xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I) & xSht.Cells(I + 1, 2))
อื่น
xNSht.Move , ชีต(ชีต.นับ)
End If
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
ต่อไป
xSht.AutoFilterMode = เท็จ
xSht.เปิดใช้งาน
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สิ่งนี้มีประโยชน์อย่างยิ่ง เป็นสิ่งที่ฉันกำลังมองหา ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสนี้มีประโยชน์มากและเกือบจะเป็นสิ่งที่ฉันกำลังมองหา
แต่สามารถปรับให้เป็นสองแผ่นได้-
แผ่นที่ 1 เป็นข้อมูล - ตารางข้อมูลโดยคอลัมน์ A เป็นชื่อ
แผ่นที่ 2 เป็นแม่แบบ มีหลายช่องที่ต้องกรอก
ฉันหวังว่าจะได้เรียกใช้มาโครซึ่งจะ
1 คัดลอกและวางแม่แบบในไฟล์เดียวกันตั้งชื่อแผ่นงานเป็นชื่อในเซลล์ A1
2 คัดลอกเซลล์ B1 จากนั้นวางลงในช่องที่เลือกในเทมเพลตใหม่
3 ทำซ้ำตามแถวที่ 1 จนว่าง
4 แล้วทำซ้ำสำหรับแถวที่ 2 และแต่ละแถวจนจบ
ผลลัพธ์เป็นไฟล์ที่มี x no. แผ่นงานเหมือนกันทุกประการกับแม่แบบ โดยกรอกข้อมูลในฟิลด์ทั้งหมด
ฉันได้รับไฟล์ที่ทำงานในลักษณะอื่น โดยดึงข้อมูลจากเทมเพลตไปยังตาราง แต่ไม่สามารถย้อนกลับได้.....
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน คุณแซม
คงจะดีถ้าคุณสามารถแนบสมุดงานของคุณที่นี่
คุณสามารถอัปโหลดไฟล์ด้วยปุ่มอัปโหลดไฟล์ด้านล่าง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันพยายามใช้รหัสของคุณแต่ได้รับข้อผิดพลาด
ข้อผิดพลาดรันไทม์ '1004':
ข้อผิดพลาดที่กำหนดโดยแอปพลิเคชันหรือกำหนดวัตถุ
ฉันไม่มีความรู้เกี่ยวกับ VBA (หรือเทคโนโลยีใดๆ สำหรับเรื่องนั้น) แต่ถ้ามีการดีบักแบบกด จะไฮไลต์บรรทัดที่ 11 xRCount=xSht.Cells(xSht.Rows.Count,1) สิ้นสุด(xIUp).แถว
ฉันกำลังทำงานกับไฟล์ขนาดใหญ่ที่มี 127 คอลัมน์และ 337 แถว (แถวจะแตกต่างกันไปในแต่ละคอลัมน์) และเป็นรายการที่มีตัวเลขและรายละเอียด
ฉันเปลี่ยนช่วงตามที่คุณสังเกตแล้ว แต่ยังใช้งานไม่ได้ ฉันใช้ Excel 2010 คุณช่วยบอกวิธีทำให้มันทำงานได้ไหม ถ้าเป็นไปได้
ขอขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน เบียทริซ
รหัสได้รับการปรับปรุงด้วยการแก้ปัญหา โปรดลองอีกครั้ง ขอบคุณสำหรับความคิดเห็นของคุณ.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันคิดว่ามีบางอย่างที่เป็นประโยชน์สำหรับสถานการณ์ของฉัน แต่ฉันสามารถทำ VBA หรือสคริปต์ได้ หวังว่าคุณจะช่วยได้
ฉันมีเทมเพลตที่มีข้อมูลหลายเซลล์ และจะมีแป้นค้นหา (ไม่ซ้ำกัน) ที่ฉันต้องการป้อนลงในเทมเพลต ตามคีย์การค้นหา ข้อมูลจะถูกค้นหาและข้อมูลที่ตรงกันบนคีย์ที่ตรงกันจะถูกดึงและกรอกข้อมูลลงในเทมเพลต เทมเพลตที่เติมจะถูกบันทึกลงในเวิร์กชีตใหม่ อาจมีมากกว่า 1 รายการการแข่งขัน ฉันต้องการสคริปต์เพื่อค้นหารายการต่อไป จนกว่าจะมีการเลือกที่ตรงกันทั้งหมด และสร้างเวิร์กชีตใหม่ตามจำนวนที่กำหนด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี มีวิธีเก็บแถวหัวเรื่องบนแผ่นงานใหม่แต่ละแผ่นหรือไม่ (วงกลมสีแดงบนไฟล์แนบของฉัน)

รหัสนำแถวทั้งหมดจากแผ่นงานหลักของฉันและโอนไปยังแผ่นงานใหม่ ซึ่งดีมาก แต่ฉันต้องการให้ค่าส่วนหัว "หลัก" ของฉัน (วงกลมสีแดง) อยู่ที่ด้านบนสุดของแผ่นงานใหม่แต่ละแผ่น ขอบคุณ!



ฉันกำลังอ้างถึงรหัสนี้จากด้านบน:

ย่อย RowToSheet()
Dim xRow ตราบใดที่
หรี่ฉันนาน
ด้วย ActiveSheet
xRow = .Range("A" & Rows.Count).End(xlUp).Row
สำหรับฉัน = 1 ถึง xRow
Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
.Rows(I).Copy Sheets("Row " & I).Range("A1")
ถัดไปฉัน
จบด้วย
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสที่ดี แต่ฉันขอความช่วยเหลือได้ไหมถ้าฉันข้อมูลอยู่ในคอลัมน์ G แทนที่จะเป็นคอลัมน์ A ฉันต้องเปลี่ยนอะไรเพื่อให้มีข้อมูลคอลัมน์ G ในแท็บอื่น

ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นี่คือรหัสที่ดี ขอบคุณมากสำหรับกล่องสมองที่ OfficeExtend !! มีโค้ดนี้ไหมที่สามารถดัดแปลงเล็กน้อยเพื่อสร้างชีตแยกกันสำหรับแต่ละ *คอลัมน์* แทนที่จะเป็นแถว ฉันได้แนบรูปภาพของสิ่งที่ฉันพยายามจะบรรลุ เป็นไปได้ไหม ขอแสดงความนับถือ.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอให้เป็นวันที่ดี,
ฉันไม่เห็นรูปของคุณที่นี่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี วิธีแก้ไขรหัสถ้าฟิลด์ชื่อของฉันอยู่ในคอลัมน์ C
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีอับดุลบาสิต
รหัส VBA ด้านล่างสามารถช่วยคุณได้ ได้โปรดลองดู
ในบรรทัด: xCName = "3", 3 หมายถึงหมายเลขคอลัมน์ (นี่คือคอลัมน์ C) ใน Excel คุณสามารถเปลี่ยนเป็นหมายเลขคอลัมน์ใดก็ได้ตามที่คุณต้องการ

ย่อย parse_data()
'อัพเดทโดย Extendoffice 2018 / 3 / 2
Dim xRCount ตราบใดที่
Dim xSht เป็นแผ่นงาน
Dim xNSht เป็นเวิร์กชีต
หรี่ฉันนาน
Dim xTRrow เป็นจำนวนเต็ม
Dim xCol เป็นคอลเลกชั่นใหม่
Dim xTitle เป็นสตริง
Dim xSUpdate เป็นบูลีน
Dim xCName เป็นจำนวนเต็ม
Dim xTA, xRA, xSRg1 เป็นสตริง
ตั้งค่า xSht = ActiveSheet
เกี่ยวกับข้อผิดพลาดต่อไป
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:C1"
xCName = "3" 'เปลี่ยนหมายเลขนี้เป็นหมายเลขคอลัมน์ซึ่งคุณจะสร้างชีตใหม่ตาม
xTRrow = xSht.Range(xTitle).Cells(1).Row
สำหรับฉัน = 2 ถึง xRCount
โทร xCol.Add(xSht.Cells(I, xCName).Text, xSht.Cells(I, xCName).Text)
ต่อไป
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = เท็จ
xSRg = xSht.Cells(1, xCName).Address(RowAbsolute:=False, ColumnAbsolute:=False)
สำหรับฉัน = 1 ถึง xCol.Count
โทร xSht.Range(xTitle).AutoFilter(xCName, CStr(xCol.Item(I)))
ตั้งค่า xNSht = Nothing
ตั้งค่า xNSht = แผ่นงาน (CStr(xCol.Item(I)))
ถ้า xNSht ไม่มีอะไรแล้ว
ตั้งค่า xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
อื่น
xNSht.Move , ชีต(ชีต.นับ)
End If
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
ต่อไป
xSht.AutoFilterMode = เท็จ
xSht.เปิดใช้งาน
Application.ScreenUpdating = xSUpdate
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัส VBA เจ๋ง ๆ ที่จะทำเคล็ดลับ

ฉันจะแก้ไขไม่ให้คัดลอกคอลัมน์แรกได้อย่างไร และเพื่อลบชื่อคอลัมน์?

ความนับถือ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ได้โปรดขอความช่วยเหลือเกี่ยวกับวิธีการตั้งชื่อแผ่นงานโดยอัตโนมัติโดยใช้คอลัมน์ใดคอลัมน์หนึ่ง ใช้สำหรับ VBA แบบแถวต่อชีต ดูด้านล่าง

ย่อย RowToSheet()

Dim xRow ตราบใดที่

หรี่ฉันนาน

ด้วย ActiveSheet

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

สำหรับฉัน = 1 ถึง xRow

Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I

.Rows(I).Copy Sheets("Row " & I).Range("A1")

ถัดไปฉัน

จบด้วย

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไม่เป็นไรมันเป็นช่องว่างต่อท้ายที่ซ่อนอยู่ ฉันใช้คุณสมบัติ TRIM และทำความสะอาด การนับแถว (การนับบรรทัดจริง ๆ ดังนั้นแถว -1 ที่ต่อท้ายแผ่นงานจะน่าทึ่งมาก)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จะอ้างอิงการใช้รหัสด้านบนได้อย่างไร (เครดิต) ? เป็นไปได้ไหมที่จะแก้ไขรหัส?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี นี่คือแพลตฟอร์มการสื่อสารแบบเปิด รหัสได้รับอนุญาตให้อ้างอิงและแก้ไข
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นานา
86
2
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี! ฉันเพิ่งใช้รหัสนี้และใช้งานได้! นอกเหนือจากการสร้างชีตใหม่สำหรับแต่ละรายการ ฉันต้องการย้ายไปยังคอลัมน์แต่คิดไม่ออก จากตัวอย่างข้างต้น ผลลัพธ์ของนานาจะมีลักษณะดังนี้ - ชื่อ - นามสกุล นานาคะแนน 86No. 2
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ใช้รหัสนี้แล้วใช้งานได้ แต่หากฉันต้องการเลือกมากกว่าหนึ่งแถวในส่วนหัว สิ่งที่จะเปลี่ยนแปลงในรหัส ? ฉันมีหลายบรรทัดในแผ่นงานที่ฉันต้องการในทุกแผ่น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี คุณรู้หรือไม่ว่าอย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี มีรหัสที่จะเพิ่มแผ่นงานใหม่เพียง 1 แผ่นทุกครั้งที่มีการเรียกใช้มาโคร เช่น ครั้งแรกที่มีการตั้งชื่อแผ่นงานใหม่บนเนื้อหาของเซลล์ A1 การเรียกใช้มาโครครั้งที่ 1 จะมีการตั้งชื่อแผ่นงานใหม่บน เนื้อหาของ A2 ฯลฯ ขอบคุณในความคาดหมาย
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
โหลดเพิ่มเติม
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ