Excel Vba (ปุ่ม onclick)

ฉันมีแผ่นงานที่มีคอลัมน์ "รหัสการทำงานชื่อวันที่ชื่อคำอธิบายสถานะ" รูปแบบทั้งหมดโดยทั่วไป

code:4566, 4899, 4987, 4988, 4989  
operation:X,Y,Z,X,Y  
title:XX,YY,ZZ,RR,XXY  
date: (the date column is not blank)  
name:Adam,Edward,Adam,Kris,Chris  
description: (some rows has data for this column, some are blank)  
status: active, inactive, closed

ฉันกำลังพยายามคัดลอกแถวที่คอลัมน์ 'ชื่อ' ของพวกเขามีคอลัมน์ "อดัม" หรือ "เอ็ดเวิร์ด" และ "สถานะ" พร้อมกับ "ใช้งาน" ไปยังแผ่นงานใหม่ที่มีคอลัมน์ "รหัสชื่อวันที่ชื่อคำอธิบายสถานะ" เท่านั้น (ฉันไม่ต้องการคอลัมน์ 'การทำงาน' ในแผ่นงานใหม่)

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

ในตอนท้ายค่าส่งคืนจะเป็นเพียง 2 แถว: 4566 และ 4987
ฉันสามารถทำได้ด้วยตนเอง แต่ฉันอยากลองถ้ามันสามารถทำได้โดย vba ด้วยคลิกเดียว (กระบวนการอัตโนมัติ)

ขอบคุณ.

P / S: ขออภัยที่ไม่ได้รวมสิ่งที่ฉันมีตอนนี้ที่นี่มันเป็น

Options Explicit

Sub Button1_Click()

Dim myRow As Long 'for finding last row  
Dim xlast As Integer 'x is the last row  
Dim sht As Worksheet 'original sheet  
Dim newsht As Worksheet 'sheet with new data  

Set sht = ThisWorkbook.Worksheets("Sheet1")  
Set newsht = ThisWorkbook.Worksheets("Sheet2")

myCol = code  
xlast = sht.Cells(Rows.Count, myCol).End(xlUp).Row  
'go through my code column for non-blank

For x = 1 To xlast 'from 1st row till last row  
(tab)    If (sheet.name.Cells() = "Adam" OR "Edward") And (sheet.status.Cells() = "active")  
(tab)    Then newsht.Rows.Value(code,title,date,name,description,status) = sheet.Rows().Value(code,title,date,name,description,status)  
    End If  
Next

End Sub

รหัสตัวอย่างของคุณมีปัญหาเล็กน้อย:

sheet.name.Cells () = "Adam" หรือ "Edward"

• คุณต้องตรวจสอบครั้งละหนึ่งเซลล์แทนที่จะเป็น Cells ()
• ในการอ้างถึงค่าของเซลล์คุณต้องอ้างถึงคุณสมบัติของเซลล์เช่น sheet.range (). value = "Adam"
• การเปรียบเทียบแต่ละรายการ (Adam หรือ Edward) จะต้องได้รับการประเมินแยกต่างหากเช่นช่วง (). value = "Adam" หรือ range (). value = "Edward"

newsht.Rows.Value (รหัสชื่อวันที่ชื่อคำอธิบายสถานะ)

• ค่าไม่ใช้ช่วงที่ตั้งชื่อแบบนี้
• รหัสนี้ไม่ได้ใช้ตัววนซ้ำiเพื่อบอกว่าบรรทัดใดที่จะคัดลอกข้อมูลไปยังในแผ่นงาน 2

ลองรหัสด้านล่าง คุณสามารถกำหนดให้ปุ่มถ้าคุณต้องการ คุณจะต้องเปลี่ยนช่วงดาดและnewdatเพื่อให้เหมาะกับแผ่นของคุณ การเปลี่ยนแปลงหลักจากรหัสของคุณคือการชดเชยจะใช้ในการวนซ้ำแถวและคอลัมน์ต่างๆ (ชดเชยจากมุมซ้ายบนของบล็อกข้อมูล) เพื่อตรวจสอบแต่ละบรรทัดของข้อมูล การตรวจสอบหรือคัดลอกแต่ละครั้งจะถูกเข้ารหัสอย่างชัดเจน

Sub macro2()

Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")
'Set dat = sht.Range("p9")
Set dat = sht.Range("code").Cells(1, 1)
Set newdat = newsht.Range("c2")

'initialise counters
i = 1
j = 1

'set headings on sheet 2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status



Do While dat.Offset(i, 0).Value <> "" 'loop till code data goes blank
  If ((dat.Offset(i, 4).Value = "Adam" Or dat.Offset(i, 4).Value = "Edward") And dat.Offset(i, 6).Value = "active") Then 'check conditions
    newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code
    newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title
    newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date
    newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name
    newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr
    newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status
    j = j + 1
  End If

  i = i + 1
Loop


End Sub