Board logo

標題: [發問] 請問如何將sheet1的輸入資料貼上sheet2特定儲存格 [打印本頁]
作者: hpmatri    時間: 2014-12-11 16:30     標題: 請問如何將sheet1的輸入資料貼上sheet2特定儲存格

如題要如何將學生成績>60的,例如輸入80分,判斷及格後貼到sheet2的B5儲存格,第二筆及格的貼到B6儲存格,第三筆及格貼至B7儲存格,最多貼三筆,當下一次再輸入新的成績時,先清空sheet2的三筆資料,並從第一筆B5再開始貼上,如此反覆執行!如附件.請前輩協助.thanks!!
[attach]19748[/attach]
作者: ashan0418    時間: 2014-12-11 17:01

回復 1# hpmatri

成績是取前3名，還是依Sheet1的排列的前三個即可??
作者: ashan0418    時間: 2014-12-11 17:57

本帖最後由 ashan0418 於 2014-12-11 17:59 編輯

回復 1# hpmatri

取前三名用
作者: hpmatri    時間: 2014-12-13 13:28

回復 2# ashan0418


    您好:輸入資料是一筆一筆輸入,採先進先出,第一筆及格填入b5,第二筆及格填入b6,第三筆填入b7,第四筆及格時先將sheet2前三筆清空,第四筆再填入b5,第五筆 填入b6,第六筆填入b7,第七筆及格後再將sheet2前三筆清空,再將第七筆填入b5,依此類推!
    謝謝你的回答,我目前權限不足無法下載檔案,可否請你貼上來這,我在copy到excel test,謝謝!!
作者: ashan0418    時間: 2014-12-15 15:04

  1. Dim i As Integer, last_row As Integer
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     With Target
  4.         last_row = Selection.SpecialCells(xlCellTypeLastCell).Row
  5.         
  6.         If Selection.Column = 3 And Cells(last_row, 3).Value >= 60 Then
  7.                 i = i + 1

  9.                 Sheets("sheet2").Select
  10.                 If i Mod 3 = 1 Then
  11.                     Sheets("sheet2").Cells.Delete Shift:=xlUp
  12.                     Sheets("sheet2").Range("B5").Activate
  13.                 End If
  14.                 Sheets("sheet1").Select
  15.                 Range(Cells(last_row, 1), Cells(last_row, 3)).Copy
  16.                
  17.                 Sheets("sheet2").Select
  18.                 ActiveCell.PasteSpecial
  19.                 ActiveCell.Offset(1).Select
  20.                
  21.                 Sheets("sheet1").Select
  22.         End If
  23.     End With
  24. End Sub
複製代碼
回復 4# hpmatri
作者: hpmatri    時間: 2014-12-15 21:25

回復 5# ashan0418


    大大您好:我有把您程式碼貼到excel測試,不過sheet1 輸入成績後不會copy 在sheet2,可否請大大再幫我測試看看,謝謝!!
作者: ashan0418    時間: 2014-12-16 09:21

回復 6# hpmatri


抱歉，忘了說明，是要貼在Sheet1的分頁中!!
如圖，請再試試!!

[attach]19818[/attach]
作者: Hsieh    時間: 2014-12-16 09:38

回復 4# hpmatri

工作表1模組
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. With 工作表2
  3. If Target.Count = 1 And Not Intersect(Target, Columns("C:C")) Is Nothing Then
  4.     If Target >= 60 Then
  5.        k = Application.CountA(.Range("B5:B7"))
  6.        If k = 3 Then .Range("B5:D7").ClearContents: k = 0
  7.        Target.Offset(, -2).Resize(, 3).Copy .[B5].Offset(k)
  8.     End If
  9. End If
  10. End With
  11.       
  12. End Sub
複製代碼
[attach]19820[/attach]
作者: ashan0418    時間: 2014-12-16 17:19

回復 8# Hsieh

Hsieh版主 :

    請問『Intersect(Target, Columns("C:C"))』這一段的功能是什麼??
作者: Hsieh    時間: 2014-12-16 21:49

回復 9# ashan0418


傳回兩個儲存格範圍的交集
詳細請參考Intersect說明
作者: hpmatri    時間: 2014-12-17 15:13

回復 8# Hsieh


    測試可以使用,謝謝ashan0418大及Hsieh大的協助,謝謝~



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)