我有以下VBA脚本，它执行高级过滤器并填充到新工作表。我想在我的新表上按顺序获得结果。
因此，例如，Sheet 1结果将填充在C2中的C2，Sheet 2 C3，Sheet 3中。但是如果Sheet 2没有结果，则Sheet 3将填充在C3中。有人知道任何解决方法吗？我需要将结果与表格对应。可能是一个简单的范围公式？ VBA新手在这里。
Sub louis4()
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------
'edited so it shows in the 3rd column row +1. Add the header and sheet name macro to this
On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
wksSummary.Name = "Unique data"
End If
'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets
With wksSummary
If wks.Name <> .Name Then
If Application.WorksheetFunction.CountA(wks.Range("C:C")) Then
Dim r As Range
' Get the first cell of our destination range...
Set r = .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 3)
' Perform the unique copy...
If WorksheetFunction.CountA(wks.Range("C:C")) > 1 Then
wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True
End If
' Remove the first cell at the destination range...
r.Delete xlShiftUp
End If
End If
End With
Next wks
'Headers and sheet names
Range("A1").Value = "File Name "
Range("B1").Value = "Sheet Name "
Range("C1").Value = "Column Name"
Dim intRow As Long: intRow = 2
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
Cells(intRow, 2) = Sheets(i).Name
Cells(intRow, 1) = ActiveWorkbook.Name
intRow = intRow + 1
End If
Next i
End Sub
答案 0 :(得分：0)
public class PixelBot implements NativeKeyListener{
private final Robot colorBot;
private boolean running = true;
private int lastPixelValue = 0;
public static void main(String[] args) throws Exception {
GlobalScreen.registerNativeHook();
GlobalScreen.getInstance().addNativeKeyListener(new PixelBot());
}
public PixelBot() throws AWTException {
this.colorBot = new Robot();
this.runInBackground();
}
private void checkPixel() throws AWTException {
Rectangle areaOfInterest = getAreaOfInterest();
BufferedImage image = colorBot.createScreenCapture(areaOfInterest);
int clr = image.getRGB(0, 0);
if (clr != lastPixelValue) {
int red = (clr & 0x00ff0000) >> 16;
int green = (clr & 0x0000ff00) >> 8;
int blue = clr & 0x000000ff;
System.out.println("\nPixel color changed to: Red: " + red + ", Green: " + green + ", Blue: " + blue);
Toolkit.getDefaultToolkit().beep();
lastPixelValue = clr;
Robot robot = new Robot();
robot.mousePress(InputEvent.BUTTON1_MASK);
robot.mouseRelease(InputEvent.BUTTON1_MASK);
} else {
System.out.print(".");
}
}
private Rectangle getAreaOfInterest() {
// screen size may change:
Dimension screenSize = Toolkit.getDefaultToolkit().getScreenSize();
// half of center of screen, minus 1 pixel to be captured:
int centerPointX = (int)(screenSize.getWidth() / 2 - 1);
int centerPointY = (int)(screenSize.getHeight() / 2 - 1);
Point centerOfScreenMinusOnePixel = new Point(centerPointX, centerPointY);
//System.out.println(centerPointX + " " + centerPointY);
return new Rectangle(centerOfScreenMinusOnePixel, new Dimension(1, 1));
}
private void runInBackground() {
new Thread(new Runnable() {
@Override
public void run() {
while (true) {
if(running){
try {
checkPixel();
} catch (AWTException e1) {
// TODO Auto-generated catch block
e1.printStackTrace();
}
try {
Thread.sleep(1);
} catch (InterruptedException e) {
e.printStackTrace();
}
}
}
}
}).start();
}
public void stop() {
this.running = false;
}
public void start() {
this.running = true;
}
@Override
public void nativeKeyPressed(NativeKeyEvent e) {
// TODO Auto-generated method stub
System.out.println("Key Pressed: " + NativeKeyEvent.getKeyText(e.getKeyCode()));
if(NativeKeyEvent.getKeyText(e.getKeyCode()).equals("F9")){
stop();
}
else if(NativeKeyEvent.getKeyText(e.getKeyCode()).equals("F10")){
start();
}
}
}
答案 1 :(得分：0)
As per what we discussed in the comments, I believe you want this:
Sub louis4()
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------
'edited so it shows in the 3rd column row +1. Add the header and sheet name macro to this
On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
wksSummary.Name = "Unique data"
End If
'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets
With wksSummary
If wks.Name <> .Name Then
If Application.WorksheetFunction.CountA(wks.Range("C:C")) Then
Dim r As Range
' Get the first cell of our destination range...
Set r = .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 3)
' Perform the unique copy...
If WorksheetFunction.CountA(wks.Range("C:C")) > 1 Then
wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True
else
r = "N/A"
End If
' Remove the first cell at the destination range...
r.Delete xlShiftUp
End If
End If
End With
Next wks
'Headers and sheet names
Range("A1").Value = "File Name "
Range("B1").Value = "Sheet Name "
Range("C1").Value = "Column Name"
Dim intRow As Long: intRow = 2
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
Cells(intRow, 2) = Sheets(i).Name
Cells(intRow, 1) = ActiveWorkbook.Name
intRow = intRow + 1
End If
Next i
End Sub