• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

separate questions and choices of a test

Don Guillett in google group advice the formula below.but it did not work on my sheet.can anyone improve it.


Option Explicit
Option Private Module

Sub FixTestQuestionsSAS()
Dim i As Long
Dim c As Integer
Dim ml As String
Dim x As Long
Dim mr As Range
Dim mrr As Long

Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
For c = 69 To 65 Step -1
ml = Chr(c) & ")"
x = InStrRev(Cells(i, 1), ml)
'MsgBox x

If x > 0 Then
'MsgBox Chr(c) & " found in row " & i & " in position " & x
Range("b2").Insert
Range("b2").Value = Mid(Cells(i, 1), x, 256)
'MsgBox Left(Cells(i, 1), x)
Cells(i, 1) = Left(Cells(i, 1), x - 1)
ElseIf Not IsNumeric(Left(Cells(i, 1), 1)) Then
Cells(i - 1, 1) = Cells(i - 1, 1) & " " & Cells(i, 1)
Cells(i, 1).Clear
End If

Next c

Next i
'line em up
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) <> "" Then
Set mr = Columns("B").Find(What:="A)", After:=Cells(i - 1, 2), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not mr Is Nothing Then mrr = mr.Row
'MsgBox mrr
Cells(i, 1).Cut Destination:=Cells(mrr, 1)
End If
Next i

Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Sub GetRawData()
Columns("A:C").ClearContents
Sheets("Sayfa1").Range("A1:A15").Copy Range("a1")
End Sub
 
Arkadaş Türkçe bilmiyor herhalde. Ben uğraştım ama yapamadım. Belki yapabilen arkadaşlarımız olur diye ben yappılması isteneni tercüme edeyim:

Sayfa1'de A sütununda sorular ve şıklar var. Öyle bir makro olmalı ki dosyanın son hali C ve D sütunundaki gibi bir sütunda sorular ve yan sütunda da cevaplar olmalı. Ayrıca cevaplar da her şık ayrı satırda olmalı. Öyle ki A sütununda sorular tek hücrede ya da daha çok hücrede olabilir aynı şekilde şıklar da tek hücrede ya da daha çok hücrede olabilir.

Google grubundan Don Guilett diye biri yukardaki kodları hazırlamış ama arkadaş kendisine uyarlayamamış, ben de denedim ama olmadı.

Bi el atın sevaptır:)
 
Geri
Üst